Mastering Visual Basic 6/mastvb6.iso/leadtools/ocx32.lt/view.frm

Visual Basic Form | 1998-06-30 | 22.0 KB | 563 lines

VERSION 5.00
Object = "{00100003-B1BA-11CE-ABC6-F5B2E79D9E3F}#1.0#0"; "LTOCX10N.OCX"
Begin VB.Form ViewFrm
   Appearance      =   0  'Flat
   BackColor       =   &H00FFFFFF&
   Caption         =   "Viewing Window"
   ClientHeight    =   3600
   ClientLeft      =   4125
   ClientTop       =   1605
   ClientWidth     =   5460
   BeginProperty Font
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Icon            =   "view.frx":0000
   LinkTopic       =   "Viewer"
   MDIChild        =   -1  'True
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3600
   ScaleWidth      =   5460
   Visible         =   0   'False
   Begin LEADLib.LEAD Lead1
      Height          =   1575
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   2055
      _Version        =   65536
      _ExtentX        =   3625
      _ExtentY        =   2778
      _StockProps     =   229
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ScaleHeight     =   105
      ScaleWidth      =   137
      DataField       =   ""
      BitmapDataPath  =   ""
      AnnDataPath     =   ""
      PanWinTitle     =   "PanWindow"
      CLeadCtrl       =   0
   End
   Begin LEADLib.LEAD Lead2
      Height          =   1815
      Left            =   2760
      TabIndex        =   1
      Top             =   1560
      Width           =   2175
      _Version        =   65536
      _ExtentX        =   3836
      _ExtentY        =   3201
      _StockProps     =   229
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ScaleHeight     =   121
      ScaleWidth      =   145
      DataField       =   ""
      BitmapDataPath  =   ""
      AnnDataPath     =   ""
      PanWinTitle     =   "PanWindow"
      CLeadCtrl       =   0
   End
Attribute VB_Name = "ViewFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Windows functions
#If Win32 Then
Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetROP2 Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
#Else
Private Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
Private Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hdc As Integer) As Integer
Private Declare Function CreatePen Lib "GDI" (ByVal nPenStyle As Integer, ByVal nWidth As Integer, ByVal crColor As Long) As Integer
Private Declare Function GetStockObject Lib "GDI" (ByVal nIndex As Integer) As Integer
Private Declare Function SelectObject Lib "GDI" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
Private Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
Private Declare Function GetROP2 Lib "GDI" (ByVal hdc As Integer) As Integer
Private Declare Function SetROP2 Lib "GDI" (ByVal hdc As Integer, ByVal nDrawMode As Integer) As Integer
Private Declare Function Ellipse Lib "GDI" (ByVal hdc As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
Private Declare Function LineTo Lib "GDI" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer) As Integer
Private Declare Function MoveTo Lib "GDI" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer) As Long
Private Declare Function Rectangle Lib "GDI" (ByVal hdc As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
#End If
'Windows constants
Const PS_SOLID = 0
Const WHITE_BRUSH = 0
Const HOLLOW_BRUSH = 5
Const WHITE_PEN = 6
Const R2_NOT = 6
Dim StartX As Integer       'Starting point for click and drag, in screen pixels
Dim StartY As Integer       'Starting point for click and drag, in screen pixels
Dim EndX As Integer         'Ending point for click and drag, in screen pixels
Dim EndY As Integer         'Ending point for click and drag, in screen pixels
Dim BStartX As Integer      'Starting point for click and drag, in bitmap pixels
Dim BStartY As Integer      'Starting point for click and drag, in bitmap pixels
Dim BEndX As Integer        'Ending point for click and drag, in bitmap pixels
Dim BEndY As Integer        'Ending point for click and drag, in bitmap pixels
Dim Drawing As Integer      'True if the mouse button is down during any drawing action
Dim FirstDraw As Integer    'True for the first MouseMove event when we are drawing
Public FileName As String  'The file that we load to the Lead1 control on this form
Public ViewFactor As Integer   'Width of the drawing line, in bitmap pixels
Public DrawObject As Integer   'Refer to the DECL module for constants
Public DrawColor As Integer    'Refer to the DECL module for constants
Public Sub UndoZoom()
    Lead1.AutoScroll = True
    Lead1.top = 0
    Lead1.left = 0
    Lead1.Width = ScaleWidth
    Lead1.Height = ScaleHeight
    Lead1.SetSrcRect 0, 0, Lead1.BitmapWidth, Lead1.BitmapHeight
    Lead1.SetSrcClipRect 0, 0, Lead1.BitmapWidth, Lead1.BitmapHeight
    Lead1.SetDstRect 0, 0, Lead1.BitmapWidth, Lead1.BitmapHeight
    Lead1.SetDstClipRect 0, 0, Lead1.BitmapWidth, Lead1.BitmapHeight
    Lead1.BackErase = True
End Sub
Private Sub Form_Load()
  Lead1.UnlockSupport L_SUPPORT_EXPRESS, L_KEY_EXPRESS
  Lead1.UnlockSupport L_SUPPORT_GIFLZW, L_KEY_GIFLZW
  Lead1.UnlockSupport L_SUPPORT_TIFLZW, L_KEY_TIFLZW
  Lead1.UnlockSupport L_SUPPORT_MEDICAL, L_KEY_MEDICAL
  gNumChildren = gNumChildren + 1
  DrawColor = COLOR_BLACK
  DrawObject = OBJECT_ELLIPSE
  DiffWidth = Width - ScaleWidth
  DiffHeight = Height - ScaleHeight
  Lead1.left = 0
  Lead1.top = 0
  Lead1.AutoScroll = True
  Lead1.AutoRepaint = True
  Lead1.BackErase = True
  If gNumChildren = 1 Then
    Main.SaveFile(2).Enabled = True
    Main.MenuObject.Enabled = True
    Main.MenuColor.Enabled = True
    Main.MenuThickness.Enabled = True
    Main.MenuDraw.Enabled = True
    Main.MenuWindow.Enabled = True
  End If
End Sub
Private Sub Form_Resize()
    Lead1.Width = Width - DiffWidth
    If Height >= DiffHeight Then
        Lead1.Height = Height - DiffHeight
    Else
        Lead1.Height = 0
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
  gNumChildren = gNumChildren - 1
  If gNumChildren = 0 Then
    Main.SaveFile(2).Enabled = False
    Main.MenuObject.Enabled = False
    Main.MenuColor.Enabled = False
    Main.MenuThickness.Enabled = False
    Main.MenuDraw.Enabled = False
    Main.MenuWindow.Enabled = False
  End If
  Lead1.Bitmap = 0
  Lead2.Bitmap = 0
End Sub
Private Sub Lead1_Change()
    If Lead1.Bitmap <> 0 And DrawMenu = "Disabled" Then
        SaveMode = Lead1.ScaleMode
        Lead1.ScaleMode = 3 'Pixels
        Caption = FileName + "  (" + CStr(Lead1.BitmapWidth) + " x " + CStr(Lead1.BitmapHeight) + " - " + CStr(Lead1.BitmapBits) + " BPP)"
        Lead1.ScaleMode = SaveMode
    End If
End Sub
Private Sub Lead1_GotFocus()
    'Handle the situation when drawing is disabled.
    If DrawMenu = "Disabled" And Lead1.Bitmap <> 0 Then

        SaveMode = Lead1.ScaleMode
        Lead1.ScaleMode = 3 'Pixels
        Caption = FileName + "  (" + CStr(Lead1.BitmapWidth) + " x " + CStr(Lead1.BitmapHeight) + " - " + CStr(Lead1.BitmapBits) + " BPP)"
        Lead1.ScaleMode = SaveMode

        If Lead1.DstWidth <> Lead1.SrcWidth Or Lead1.DstHeight <> Lead1.SrcHeight Then
            UndoZoom
        End If
    End If
End Sub
Private Sub Lead1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    'Set the variables to use when specifying positions on the bitmap
    If DrawMenu <> "Disabled" Then

        'Use pixels because GDI functions require that scale mode
        Lead1.ScaleMode = 3
        Lead2.ScaleMode = 3

        'Initialize the zoomf factors
        If Lead1.Bitmap <> 0 Then
            ZoomFactorX = Lead1.DstWidth / Lead1.SrcWidth
            ZoomFactorY = Lead1.DstHeight / Lead1.SrcHeight
        End If

        'Determine the mouse coordinates on the screen.
        'These coordinates are converted to pixels for use with the GDI functions.
        StartX = x / Screen.TwipsPerPixelX
        StartY = y / Screen.TwipsPerPixelY

        'Determine the mouse coordinates on the bitmap.
        'These coordinates account for the zoom factor and offset.
        BStartX = (StartX / ZoomFactorX) - (Lead1.DstLeft / ZoomFactorX) + Lead1.SrcLeft
        BStartY = (StartY / ZoomFactorY) - (Lead1.DstTop / ZoomFactorY) + Lead1.SrcTop

        FirstDraw = True
        Drawing = True
        Lead1.AutoRepaint = False
    End If

    'The rest of this procedure is for pasting
    If DrawMenu <> "Paste" Then Exit Sub
    'Get the image from the clipboard
    If Lead2.Paste(PASTE_ISREADY) = 0 Then
        MsgBox ("Invalid data on the clipboard")
        Exit Sub
    Else
        Lead2.Paste 0
    End If
    'Set the mouse to an hourglass while pasting
    Lead1.MousePointer = 11
    'If Lead1 has a palette, see if the Lead2 palette matches it.
    If Lead1.BitmapBits < 16 Then
        If Lead2.BitmapBits > 8 Then
            'Lead2 has no palette.
            fMustDoColorRes = True
        Else
            'Check to see if the palettes match.
            NoColors = 2 ^ Lead1.BitmapBits
            fMustDoColorRes = False
            For i = 0 To NoColors - 1
                If Lead1.BitmapPalette(i) <> Lead2.BitmapPalette(i) Then
                    fMustDoColorRes = True
                    Exit For
                End If
            Next i
        End If
        'If it is not the same palette, let the user decide whether to continue.
        If fMustDoColorRes = True Then
            nRet = MsgBox("Palette mismatch. Convert to 24-bit?", vbYesNo)
            If nRet = vbYes Then
                Lead1.ColorRes 24, CRP_BYTEORDERBGR, 0, 0
                Lead2.ColorRes 24, CRP_BYTEORDERBGR, 0, 0
            Else
                Exit Sub
            End If
        End If
    ElseIf Lead2.BitmapBits <> Lead1.BitmapBits Then
        'Convert Lead2 to the same bits per pixel as Lead1 (16 or 24)
        Lead2.ColorRes Lead1.BitmapBits, CRP_BYTEORDERBGR, 0, 0
    End If
    'Combine Lead2 with Lead1 at the current mouse position.
    MyOp = CB_OP_ADD + CB_DST_0 'Operation flags for a simple paste.
    Lead1.Combine BStartX, BStartY, Lead2.SrcWidth, Lead2.SrcHeight, Lead2.Bitmap, 0, 0, MyOp
    'Repaint the changed portion of the bitmap
    Lead1.SetSrcClipRect BStartX, BStartY, Lead2.SrcWidth, Lead2.SrcHeight
    Lead1.BackErase = False
    Lead1.ForceRepaint
    Lead1.SetSrcClipRect Lead1.SrcLeft, Lead1.SrcTop, Lead1.SrcWidth, Lead1.SrcHeight
    'Set the mouse pointer back to the default
    Lead1.MousePointer = 0
    Drawing = True
End Sub
Private Sub Lead1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim XPixels As Integer
  Dim YPixels As Integer
  Dim DisplayMode As Integer
#If Win32 Then
  Dim LeadDC As Long
  Dim hOldPen As Long
  Dim hOldBrush As Long
  Dim OldPoint As POINTAPI
#Else
  Dim LeadDC As Integer
  Dim hOldPen As Integer
  Dim hOldBrush As Integer
#End If
  If DrawMenu = "Object" Then
    Lead1.MousePointer = 2
    XPixels = x / Screen.TwipsPerPixelX
    YPixels = y / Screen.TwipsPerPixelY
    Caption = "Mouse X = " + CStr(XPixels) + ", Mouse Y = " + CStr(YPixels)
    If Button = 1 Then
      LeadDC = Lead1.GetClientDC
      hOldPen = SelectObject(LeadDC, GetStockObject(WHITE_PEN))
      hOldBrush = SelectObject(LeadDC, GetStockObject(HOLLOW_BRUSH))
      DisplayMode = GetROP2(LeadDC)
      ret = SetROP2(LeadDC, R2_NOT)
      Select Case DrawObject
        Case OBJECT_ELLIPSE:
          If FirstDraw <> True Then
            ReturnVal = Ellipse(LeadDC, StartX, StartY, EndX, EndY)
          End If
          EndX = XPixels
          EndY = YPixels
          ReturnVal = Ellipse(LeadDC, StartX, StartY, EndX, EndY)
        Case OBJECT_LINE:
          If FirstDraw <> True Then
#If Win32 Then
            ReturnVal = MoveToEx(LeadDC, StartX, StartY, OldPoint)
#Else
            ReturnVal = MoveTo(LeadDC, StartX, StartY)
#End If
            ReturnVal = LineTo(LeadDC, EndX, EndY)
          End If
          EndX = XPixels
          EndY = YPixels
#If Win32 Then
          ReturnVal = MoveToEx(LeadDC, StartX, StartY, OldPoint)
#Else
          ReturnVal = MoveTo(LeadDC, StartX, StartY)
#End If
          ReturnVal = LineTo(LeadDC, EndX, EndY)
        Case OBJECT_RECTANGLE:
          If FirstDraw <> True Then
            ReturnVal = Rectangle(LeadDC, StartX, StartY, EndX, EndY)
          End If
          EndX = XPixels
          EndY = YPixels
          ReturnVal = Rectangle(LeadDC, StartX, StartY, EndX, EndY)
      End Select
      FirstDraw = False
      ret = SetROP2(LeadDC, DisplayMode)
      Lead1.ReleaseClientDC
    End If
  ElseIf DrawMenu = "Copy" Or DrawMenu = "ZoomIn" Then
    Lead1.MousePointer = 2
    XPixels = x / Screen.TwipsPerPixelX
    YPixels = y / Screen.TwipsPerPixelY
    Caption = "Mouse X = " + CStr(XPixels) + ", Mouse Y = " + CStr(YPixels)
    If Button = 1 Then
        If XPixels >= StartX Then
            rbX = StartX
        Else
            rbX = XPixels
        End If
        If YPixels >= StartY Then
            rbY = StartY
        Else
            rbY = YPixels
        End If
        rbWidth = Abs(StartX - XPixels)
        rbHeight = Abs(StartY - YPixels)
        Lead1.SetRubberBandRect rbX, rbY, rbWidth, rbHeight
        Lead1.RubberBandVisible = True
    End If
  ElseIf DrawMenu = "Paste" Then
    Lead1.MousePointer = 10
    XPixels = x / Screen.TwipsPerPixelX
    YPixels = y / Screen.TwipsPerPixelY
    Caption = "Mouse X = " + CStr(XPixels) + ", Mouse Y = " + CStr(YPixels)
  Else
    Lead1.MousePointer = DEFAULT
  End If
End Sub
Private Sub Lead1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim ColorRGB As Long
#If Win32 Then
  Dim hPen As Long
  Dim hBrush As Long
  Dim hOldBitmapPen As Long
  Dim hOldBitmapBrush As Long
  Dim hOldClientPen As Long
  Dim hOldClientBrush As Long
  Dim hOldclientpalette As Long
  Dim hLeadPalette As Long
  Dim OldPoint As POINTAPI
#Else
  Dim hPen As Integer
  Dim hBrush As Integer
  Dim hOldBitmapPen As Integer
  Dim hOldBitmapBrush As Integer
  Dim hOldClientPen As Integer
  Dim hOldClientBrush As Integer
  Dim hOldclientpalette As Integer
  Dim hLeadPalette As Integer
#End If
If Drawing = True Then
    EndX = x / Screen.TwipsPerPixelX
    EndY = y / Screen.TwipsPerPixelY
    'These coordinates account for the zoom factor and offset.
    BEndX = (EndX / ZoomFactorX) - (Lead1.DstLeft / ZoomFactorX) + Lead1.SrcLeft
    BEndY = (EndY / ZoomFactorY) - (Lead1.DstTop / ZoomFactorY) + Lead1.SrcTop
  Lead1.AutoRepaint = True
  If DrawMenu = "Object" Then
    Select Case DrawColor
      Case COLOR_BLACK
        ColorRGB = RGB(0, 0, 0)
      Case COLOR_BLUE
        ColorRGB = RGB(0, 0, 255)
      Case COLOR_GREEN
        ColorRGB = RGB(0, 255, 0)
      Case COLOR_RED
        ColorRGB = RGB(255, 0, 0)
      Case COLOR_WHITE
        ColorRGB = RGB(255, 255, 255)
    End Select
    LeadBitmapDC = Lead1.GetBitmapDC
    hPen = CreatePen(PS_SOLID, ViewFactor, ColorRGB)
    hOldBitmapPen = SelectObject(LeadBitmapDC, hPen)
    hOldBitmapBrush = SelectObject(LeadBitmapDC, GetStockObject(HOLLOW_BRUSH))
    Select Case DrawObject
      Case OBJECT_ELLIPSE:
        ReturnVal = Ellipse(LeadBitmapDC, BStartX, BStartY, BEndX, BEndY)
      Case OBJECT_LINE:
#If Win32 Then
        ReturnVal = MoveToEx(LeadBitmapDC, BStartX, BStartY, OldPoint)
#Else
        ReturnVal = MoveTo(LeadBitmapDC, BStartX, BStartY)
#End If
        ReturnVal = LineTo(LeadBitmapDC, BEndX, BEndY)
      Case OBJECT_RECTANGLE:
        ReturnVal = Rectangle(LeadBitmapDC, BStartX, BStartY, BEndX, BEndY)
    End Select
    SelectObject LeadBitmapDC, hOldBitmapPen
    SelectObject LeadBitmapDC, hOldBitmapBrush
    StartDraw = False
    Lead1.ReleaseBitmapDC
    hOldPen = DeleteObject(hPen)
    Lead1.BackErase = False ' this forces a repaint
  ElseIf DrawMenu = "Copy" Then
    Lead1.MousePointer = 11
    'Get rid of the rectangle.
    Lead1.RubberBandVisible = False
    'Get the width and height of the selected area in bitmap pixels.
    CropWidth = Abs(BEndX - BStartX)
    CropHeight = Abs(BEndY - BStartY)
    'We need at least one pixel.
    If CropWidth < 1 Or CropHeight < 1 Then
        Exit Sub
    End If
    'Create the Lead2 bitmap and load its palette if necessary.
    Lead2.CreateBitmap CropWidth, CropHeight, Lead1.BitmapBits
    If Lead1.BitmapBits < 16 Then
        NoColors = 2 ^ Lead1.BitmapBits
        For i = 0 To NoColors - 1
            Lead2.BitmapPalette(i) = Lead1.BitmapPalette(i)
        Next
    End If
    Lead2.Fill RGB(0, 0, 0)
    'Find the top left corner of the selected rectangle.
    If BStartX < BEndX Then
        xSrc = BStartX
    Else
        xSrc = BEndX
    End If
    If BStartY < BEndY Then
        ySrc = BStartY
    Else
        ySrc = BEndY
    End If
    'Use the Combine method to copy the selected rectangle to Lead2.
    MyOp = CB_OP_ADD + CB_DST_0 'Operation flags for a simple paste.
    Lead2.Combine 0, 0, CropWidth, CropHeight, Lead1.Bitmap, xSrc, ySrc, MyOp
    ' Copy the second bitmap to the clipboard
    Lead2.Copy COPY_DIB
    'Change next option to paste
    DrawMenu = "Paste"
    Main.EnableSelect(2).CHECKED = False
    Main.EnableSelect(3).CHECKED = True
    Lead1.MousePointer = 0
  ElseIf DrawMenu = "ZoomIn" Then
    'Simplify by making sure all measurements are in the same mode.
    SaveMode = ScaleMode
    ScaleMode = Lead1.ScaleMode
    'Get the origin of the rubberband rectangle.
    'Allow for different mouse drag directions
    If BStartX < BEndX Then
        CropLeft = BStartX
    Else
       CropLeft = BEndX
    End If
    If BStartY < BEndY Then
        CropTop = BStartY
    Else
       CropTop = BEndY
    End If
    'Get the height and width of the cropped area
    CropWidth = Abs(BEndX - BStartX)
    CropHeight = Abs(BEndY - BStartY)
    If CropWidth < 1 Or CropHeight < 1 Then
        Lead1.RubberBandVisible = False
        Lead1.BackErase = False ' this forces a repaint
        StartDraw = False
        Exit Sub
    End If
    'Size and redisplay the control, using the new source rectangle.
    'Set the variables used for preserving the aspect ratio.
    HeightFactor = CropHeight
    WidthFactor = CropWidth
    HeightAllowed = ScaleHeight
    WidthAllowed = ScaleWidth
    ' Hide the Lead control while we change its size and position.
    Lead1.Visible = False
    'Center the LEAD control on the form, preserving the aspect ratio.
    'Check to see if using the maximum width will make the image too tall.
    'Set the dimensions based on the result.
    If ((WidthAllowed * HeightFactor) / WidthFactor) <= HeightAllowed Then
      Lead1.left = 0
      Lead1.Width = WidthAllowed
      Lead1.Height = (Lead1.ScaleWidth * HeightFactor) / WidthFactor
      Lead1.top = (ScaleHeight - Lead1.ScaleHeight) / 2
    Else
      Lead1.top = 0
      Lead1.Height = HeightAllowed
      Lead1.Width = (Lead1.ScaleHeight * WidthFactor) / HeightFactor
      Lead1.left = (ScaleWidth - Lead1.ScaleWidth) / 2
    End If
    'Turn off scroll bars to make sure we use the full client area.
    Lead1.AutoScroll = False
    'Zoom in on the source rectangle
    Lead1.SetSrcRect CropLeft, CropTop, CropWidth, CropHeight
    Lead1.SetSrcClipRect CropLeft, CropTop, CropWidth, CropHeight
    'Set the image display size to match the LEAD control
    Lead1.SetDstRect 0, 0, Lead1.ScaleWidth, Lead1.ScaleHeight
    Lead1.SetDstClipRect 0, 0, Lead1.ScaleWidth, Lead1.ScaleHeight
    'Set defaults
    Lead1.RubberBandVisible = False
    Lead1.MousePointer = 0 'Default
    ' Display the Lead control
    Lead1.Visible = True
    Lead1.ForceRepaint
    'Return the form's scalemode to the saved value
    ScaleMode = SaveMode
    Lead1.ScaleMode = SavedMode
  End If
End If
End Sub