Сжатие, изменение размеров изображений

Option Explicit
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Type PicBmp
    size As Long
    Type As Long
    hBmp As Long
    hpal As Long
    Reserved As Long
End Type
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
 
Public Function Conv(hBmp As Long) As StdPicture
    Dim Pic As PicBmp
    Dim IID_IDispatch As GUID
    With IID_IDispatch
       .Data1 = &H20400
       .Data4(0) = &HC0
       .Data4(7) = &H46
    End With
    With Pic
       .size = Len(Pic)
       .Type = vbPicTypeBitmap
       .hBmp = hBmp
    End With
    OleCreatePictureIndirect Pic, IID_IDispatch, 1, Conv
End Function
Private Sub imgPic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim d As Single, w As Long, h As Long, ohBmp As Long, hBmp As Long, DC As Long, p As IPicture
    If Button = vbLeftButton Then d = 1.5 Else d = 0.66
        w = ScaleX(imgPic.Picture.Width, vbHimetric, vbPixels) * d
        h = ScaleY(imgPic.Picture.Height, vbHimetric, vbPixels) * d
        If w > 0 And h > 0 Then
        imgPic.Width = w: imgPic.Height = h
        DC = CreateCompatibleDC(Me.hdc)
        hBmp = CreateCompatibleBitmap(Me.hdc, w, h)
        ohBmp = SelectObject(DC, hBmp)
        Set p = imgPic.Picture
        p.Render DC, 0, 0, w, h, 0, imgPic.Picture.Height, imgPic.Picture.Width, -imgPic.Picture.Height, ByVal 0
        SelectObject DC, ohBmp
        DeleteDC DC
        Set imgPic.Picture = Conv(hBmp)
        Me.Width = (Me.Width / Screen.TwipsPerPixelX - Me.ScaleWidth + w + imgPic.Left * 2) * Screen.TwipsPerPixelX
        Me.Height = (Me.Height / Screen.TwipsPerPixelY - Me.ScaleHeight + h + imgPic.Top * 2) * Screen.TwipsPerPixelY
    End If
End Sub