Пропорциональное увеличение/уменьшение картинки

Option Explicit
 
Private WithEvents picCanvas    As PictureBox
 
Private Sub DrawFit( _
            ByVal hdc As Long, _
            ByVal cPic As IPicture, _
            ByVal ldw As Long, _
            ByVal ldh As Long)
    Dim lsw As Long
    Dim lsh As Long
    Dim ldx As Long
    Dim ldy As Long
    Dim lrw As Long
    Dim lrh As Long
    Dim fdt As Single
    
    lsw = CLng(((cPic.Width / 2540) * 1440) / Screen.TwipsPerPixelX)
    lsh = CLng(((cPic.Height / 2540) * 1440) / Screen.TwipsPerPixelY)
    ldx = (ldw - lsw) \ 2
    ldy = (ldh - lsh) \ 2
      
    If ldx < 0 Or ldy < 0 Then
    
        If ldx < ldy Then
            fdt = ldw / lsw: lrw = ldw:  lrh = lsh * fdt
        Else
            fdt = ldh / lsh: lrh = ldh:  lrw = lsw * fdt
        End If
        
        ldx = (ldw - lrw) \ 2
        ldy = (ldh - lrh) \ 2
        
    Else
        lrw = lsw:  lrh = lsh
    End If
 
    cPic.Render hdc, ldx, ldy, lrw, lrh, 0, cPic.Height, cPic.Width, -cPic.Height, ByVal 0&
    
End Sub
 
Private Sub Form_Load()
    
    Set picCanvas = Me.Controls.Add("VB.PictureBox", "picCanvas")
    
    picCanvas.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
    picCanvas.OLEDropMode = 1
    picCanvas.AutoRedraw = True
    picCanvas.ScaleMode = vbPixels
    picCanvas.Visible = True
    
End Sub
 
Private Sub picCanvas_OLEDragDrop( _
            ByRef Data As DataObject, _
            ByRef Effect As Long, _
            ByRef Button As Integer, _
            ByRef Shift As Integer, _
            ByRef X As Single, _
            ByRef Y As Single)
    Dim vFile   As Variant
    Dim cPic    As StdPicture
    
    On Error GoTo err_handler
    
    For Each vFile In Data.Files
            
        Set cPic = LoadPicture(vFile)
        
        picCanvas.Cls
        
        DrawFit picCanvas.hdc, cPic, picCanvas.ScaleWidth, picCanvas.ScaleHeight
        
        picCanvas.Refresh
        
    Next
    
err_handler:
    
End Sub

'High quality stretch Blt
Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal hStretchMode As Long) As Long
Public Const STRETCHMODE = vbPaletteModeNone.

    lsw = CLng(ScaleX(cPic.width, vbHimetric, vbPixels))
    lsh = CLng(ScaleY(cPic.height, vbHimetric, vbPixels))

DrawFit Picture1.hDC, cPic, Picture1.Width / Screen.TwipsPerPixelX, Picture1.Height / Screen.TwipsPerPixelY