Vb6 在VB 6.0中调整用户上传照片的大小以适合我的图片框
我正在使用VB6.0开发一个库存管理项目。现在我想包括一个功能,允许用户上传他的项目照片到我的系统。然后我想把它保存到数据库中。另外,我想把照片尺寸限制在600*600。因此,当用户上传的图片大于600*600像素时,我的系统应该自动调整图片大小,以适合我的图片框。有人能帮忙吗?提前感谢。没有简单的方法可以做到这一点。我将利用VB标准控件的副作用。使用form/UserControl/which,并坚持使用以下控件:Vb6 在VB 6.0中调整用户上传照片的大小以适合我的图片框,vb6,Vb6,我正在使用VB6.0开发一个库存管理项目。现在我想包括一个功能,允许用户上传他的项目照片到我的系统。然后我想把它保存到数据库中。另外,我想把照片尺寸限制在600*600。因此,当用户上传的图片大于600*600像素时,我的系统应该自动调整图片大小,以适合我的图片框。有人能帮忙吗?提前感谢。没有简单的方法可以做到这一点。我将利用VB标准控件的副作用。使用form/UserControl/which,并坚持使用以下控件: // This will be your uploaded images fo
// This will be your uploaded images folder
string target = Server.MapPath("~/ImageFolder" );
Image.GetThumbnailImageAbort thumbnailImageAbortDelegate =
new Image.GetThumbnailImageAbort(ThumbnailCallback);
foreach (UploadedFile file in RadUpload1.UploadedFiles)
{
file.SaveAs(Path.Combine(target, file.GetName()));
using (Bitmap originalImage = new Bitmap(file.InputStream))
{
// Set the resize here. You can use a constant or set a function here.
int width = 600;
int height = 600;
using (Image thumbnail = originalImage.GetThumbnailImage(width, height, thumbnailImageAbortDelegate, IntPtr.Zero))
{
string thumbnailFileName = Path.Combine(target,
string.Format("{0}_thumb{1}" , file.GetNameWithoutExtension(), file.GetExtension()));
thumbnail.Save(thumbnailFileName);
}
}
}
- 图像控制
- 图像控制
- 图文箱控制
Option Explicit
' Edit these if you change your mind about the photo size.
Private Const m_ksngMaxPixelsX As Single = 600!
Private Const m_ksngMaxPixelsY As Single = 600!
Private Sub cmdLoad_Click()
On Error GoTo ErrorHandler:
dlgOpen.Filter = "Picture Files|*.bmp;*.jpg;*.gif"
dlgOpen.ShowOpen
UploadPicture dlgOpen.FileName
Exit Sub
ErrorHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
Private Sub Form_Load()
Me.ScaleMode = vbPixels
pbCanvas.ScaleMode = vbPixels
imgPic.Width = m_ksngMaxPixelsX
imgPic.Height = m_ksngMaxPixelsY
imgSize.Visible = False
pbCanvas.Visible = False
pbCanvas.AutoRedraw = True
End Sub
' Get a new filename, based on the original. It will always be a BMP bitmap.
Private Function GetResizedFilename(ByRef the_sFilename As String) As String
Dim nPosDot As Long
On Error GoTo ErrorHandler
nPosDot = InStrRev(the_sFilename, ".")
GetResizedFilename = Left$(the_sFilename, nPosDot - 1) & "-resized.bmp"
Exit Function
ErrorHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Function
Private Sub ProcessPicture(ByRef the_sFilename As String, ByRef out_sProcessedFilename As String)
Dim sngPixelsX As Single
Dim sngPixelsY As Single
On Error GoTo ErrorHandler
' Get the size of our picture. Would have liked to have used a StdPicture object here, instead.
Set imgSize.Picture = LoadPicture(the_sFilename)
sngPixelsX = imgSize.Width
sngPixelsY = imgSize.Height
' If at least one of height and width is too bix, resize the biggest value down to m_ksngMaxPixels? and resize the other value proportionally.
If sngPixelsX > m_ksngMaxPixelsX Or sngPixelsY > m_ksngMaxPixelsY Then
If sngPixelsX > sngPixelsY Then
sngPixelsY = m_ksngMaxPixelsY * sngPixelsY / sngPixelsX
sngPixelsX = m_ksngMaxPixelsX
Else
sngPixelsX = m_ksngMaxPixelsX * sngPixelsX / sngPixelsY
sngPixelsY = m_ksngMaxPixelsY
End If
' Resize the canvas so that the persistent bitmap is the same size as the final picture, and then paint our picture onto that canvas, resizing down.
pbCanvas.Move 0!, 0!, sngPixelsX, sngPixelsY
pbCanvas.PaintPicture imgSize.Picture, 0!, 0!, sngPixelsX, sngPixelsY
' Get a reference to the persistent bitmap.
Set imgPic.Picture = pbCanvas.Image
out_sProcessedFilename = GetResizedFilename(the_sFilename)
SavePicture pbCanvas.Image, out_sProcessedFilename
Else
out_sProcessedFilename = the_sFilename
Set imgPic.Picture = imgSize.Picture
End If
Exit Sub
ErrorHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
Private Sub SaveToDatabase(ByRef the_sProcessedFilename As String)
Dim nFileNo As Integer
Dim abytPictureFile() As Byte
Dim nFileLen As Long
' Open the file in binary mode, resize a byte array to fit the file's contents, load it into the array, and close the array.
nFileNo = FreeFile
Open the_sProcessedFilename For Binary As #nFileNo
nFileLen = LOF(nFileNo)
ReDim abytPictureFile(1 To nFileLen)
Get #nFileNo, , abytPictureFile()
Close #nFileNo
'
' YOUR WORK INSERTED HERE
'
Exit Sub
ErrorHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
Private Sub UploadPicture(ByRef the_sFilename As String)
Dim sProcessedFilename As String
On Error GoTo ErrorHandler
ProcessPicture the_sFilename, sProcessedFilename
SaveToDatabase sProcessedFilename
Exit Sub
ErrorHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
这看起来像是C#-而不是VB6。马克·贝滕肖,谢谢你的编码。这对我帮助很大。顺便说一句,我想知道为什么在我调整照片大小后,它的大小似乎增加了。调整大小前:-尺寸:1024 x 768大小:185kb调整大小后:-尺寸:596 x 446大小:778kb是否有其他方法改进此功能?我猜您已加载JPEG或GIF文件,这两种文件都是压缩格式。不幸的是,VB只能以BMP格式保存。您必须将该文件转换回。看见