0

画像のサイズを変更してピクチャボックスにロードする関数を作成しようとしています...

これまで私はこれをやった：

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

しかし、ご覧のとおり、大量のデバッグが必要です。何が間違っているのでしょうか。これを解決するにはどうすればよいですか?

4

1 に答える 1

3

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
于 2012-09-20T18:30:39.520 に答える