Question

我试图创建一个调整图像大小并将其加载到图片框的功能......

到目前为止，我已经做到了这一点：

Function ResizeImage(Picture As ImageFile, Width As Integer, Height As Integer) As ImageFile
    Dim ratioWidth, ratioHeight, ratio As Double
    Dim newWidth, newHeight As Integer
    Dim img As ImageFile
    Set img = Picture

    'Calgulate AspectRatio
    ratioWidth = (Width / Picture.Width)
    ratioHeight = (Height / Picture.Height)

    'Choose the smaller ratio
    If ratioWidth > ratioHeight Then
        ratio = ratioHeight
    Else
        ratio = ratioWidth
    End If

    'Calgulate newWidth and newHeight
    newWidth = Picture.Width * ratio
    newHeight = Picture.Height * ratio

    'Return resized image
    ResizeImage = img.ARGBData.Picture(newWidth, newHeight)
End Function

函数调用为：

picResim.Picture = LoadPicture(PicturePath) 'Show picture first
Set PrintImg = New ImageFile                'Create a background picture
PrintImg.LoadFile PicturePath               'to process on
picResim.Picture = ResizeImage(PrintImg, 40, 30) 'Show resized picture

但是你可以看到我需要一个繁重的调试，我做错了怎么能解决这个问题？

Answer 1

我不确定你为什么要把一个图像放到PictureBox中然后把另一个放在那里，但也许这会对你有帮助吗？

Option Explicit
'Needs reference to:
'Microsoft Windows Image Acquisition Library 2.0

Private Function ResizeImage( _
    ByVal Original As WIA.ImageFile, _
    ByVal WidthPixels As Long, _
    ByVal HeightPixels As Long) As WIA.ImageFile

    'Scale the photo to fit supplied dimensions w/o distortion.
    With New WIA.ImageProcess
        .Filters.Add .FilterInfos!Scale.FilterID
        With .Filters(1).Properties
            '!PreserveAspectRatio = True by default, so just:
            !MaximumWidth = WidthPixels
            !MaximumHeight = HeightPixels
        End With
        Set ResizeImage = .Apply(Original)
    End With
End Function

Private Sub cmdBrowse_Click()
    Dim imgPhoto As WIA.ImageFile

    With dlgOpen
        .FileName = ""
        'Other CommonDialog properties were set at design-time.
        On Error Resume Next
        .ShowOpen
        If Err.Number = cdlCancel Then Exit Sub
        On Error GoTo 0

        Set imgPhoto = New WIA.ImageFile
        imgPhoto.LoadFile .FileName
    End With

    With Picture1
        Set imgPhoto = ResizeImage(imgPhoto, _
                                   ScaleX(.ScaleWidth, .ScaleMode, vbPixels), _
                                   ScaleY(.ScaleHeight, .ScaleMode, vbPixels))
        Set .Picture = imgPhoto.FileData.Picture
    End With
End Sub

在vb6中将图片大小调整为固定大小

1 个答案: