Programming Tool Box/SIMS_2.iso/code/grafik/metapr/form1.frm

Visual Basic Form | 1993-09-26 | 27.8 KB | 844 lines

VERSION 2.00
Begin Form Form1
   AutoRedraw      =   -1  'True
   Caption         =   "Form1"
   ClientHeight    =   4530
   ClientLeft      =   255
   ClientTop       =   1830
   ClientWidth     =   7770
   Height          =   5220
   Icon            =   FORM1.FRX:0000
   Left            =   195
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4530
   ScaleWidth      =   7770
   Top             =   1200
   Width           =   7890
   Begin PictureBox Picture3
      Height          =   5500
      Left            =   420
      ScaleHeight     =   5475
      ScaleWidth      =   5970
      TabIndex        =   6
      Top             =   -9000
      Width           =   6000
      Begin CommandButton Command2
         Caption         =   "&Ok"
         Height          =   372
         Left            =   4260
         TabIndex        =   7
         Top             =   3060
         Width           =   972
      End
   End
   Begin PictureBox Picture4
      BackColor       =   &H00FFFFFF&
      Height          =   3132
      Left            =   3852
      ScaleHeight     =   3105
      ScaleWidth      =   3465
      TabIndex        =   8
      Top             =   468
      Visible         =   0   'False
      Width           =   3492
      Begin PictureBox Picture6
         Height          =   2292
         Left            =   1260
         ScaleHeight     =   151
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   123
         TabIndex        =   10
         Top             =   360
         Width           =   1872
         Begin PictureBox Picture8
            BackColor       =   &H00000000&
            Height          =   96
            Left            =   900
            MousePointer    =   8  'Size NW SE
            ScaleHeight     =   4
            ScaleMode       =   3  'Pixel
            ScaleWidth      =   4
            TabIndex        =   12
            Top             =   1320
            Visible         =   0   'False
            Width           =   96
         End
         Begin PictureBox Picture7
            AutoRedraw      =   -1  'True
            Height          =   552
            Left            =   360
            ScaleHeight     =   35
            ScaleMode       =   3  'Pixel
            ScaleWidth      =   55
            TabIndex        =   11
            TabStop         =   0   'False
            Top             =   420
            Width           =   852
         End
         Begin Shape Shape1
            BorderStyle     =   3  'Dot
            Height          =   12
            Left            =   1
            Top             =   1
            Visible         =   0   'False
            Width           =   12
         End
      End
      Begin PictureBox Picture5
         BackColor       =   &H00808080&
         BorderStyle     =   0  'None
         Height          =   1992
         Left            =   480
         ScaleHeight     =   1995
         ScaleWidth      =   1635
         TabIndex        =   9
         Top             =   840
         Width           =   1632
      End
   End
   Begin PictureBox Picture2
      BackColor       =   &H00C0C0C0&
      Height          =   2925
      Left            =   0
      ScaleHeight     =   2895
      ScaleWidth      =   4605
      TabIndex        =   1
      Top             =   0
      Width           =   4635
      Begin CommandButton Command1
         Caption         =   "Ok"
         Height          =   492
         Left            =   180
         TabIndex        =   5
         Top             =   2160
         Width           =   2052
      End
      Begin FileListBox File1
         Height          =   2430
         Left            =   2340
         Pattern         =   "*.WMF"
         TabIndex        =   4
         Top             =   120
         Width           =   1935
      End
      Begin DirListBox Dir1
         Height          =   1536
         Left            =   180
         TabIndex        =   3
         Top             =   540
         Width           =   2052
      End
      Begin DriveListBox Drive1
         Height          =   300
         Left            =   180
         TabIndex        =   2
         Top             =   120
         Width           =   2052
      End
   End
   Begin PictureBox Picture1
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      DrawStyle       =   6  'Inside Solid
      FillColor       =   &H000000FF&
      FillStyle       =   0  'Solid
      ForeColor       =   &H00000000&
      Height          =   6132
      Left            =   -60
      ScaleHeight     =   407
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   531
      TabIndex        =   0
      Top             =   120
      Width           =   7992
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuOpen
         Caption         =   "&Open"
      End
      Begin Menu mnuLine
         Caption         =   "-"
         Index           =   0
      End
      Begin Menu mnuPrint
         Caption         =   "&Print"
         Begin Menu mnuFull
            Caption         =   "&Full Page"
         End
         Begin Menu mnuSel
            Caption         =   "&Selected Area"
         End
      End
      Begin Menu l1
         Caption         =   "-"
      End
      Begin Menu mnuExit
         Caption         =   "&Exit"
      End
   End
   Begin Menu mnuDisplay
      Caption         =   "&Display"
      Begin Menu mnuAnsi
         Caption         =   "&Ansiotropic"
      End
      Begin Menu mnuIso
         Caption         =   "&Isotropic"
      End
      Begin Menu l2
         Caption         =   "-"
      End
      Begin Menu mnuAbout
         Caption         =   "A&bout"
      End
   End
   Begin Menu mnuPrintPar
      Caption         =   "&Print"
      Visible         =   0   'False
   End
   Begin Menu mnuCancel
      Caption         =   "&Cancel"
      Visible         =   0   'False
   End
Option Explicit
'Being restricted to using only one form for this project
'forced me into using this form as Windows uses its resources,
'turning objects on and off and resizing according to how the form
'was being used.
'It also shows that, using API calls, Visual Basic
'can compete on speed for most operations. Compare the time it takes
'to print a whole page using this program, to the time taken to print
'the timecard example provided with VB. Set your printer up to use
'Print Manager, this will help to differentiate between page processing
'and page printing.
'The main principle to get to grips with in using graphics in Windows,
'is how to convert a point in one object into the the same point but
'in another object. This program uses points and rectangles
'and has to use them as points on screen (for clipping) or points on another
'object (for sliding and moving that object around the object beneath it).
'No special VBX's are needed for this program Windows has it all built in.
'You just need to have a good guide around the Windows API calls.
'Visual Basic Progammer's Guide to the Windows API by D Appleman
'is highly recommended, and I have found it invaluable in this project.
Dim OldMode%
Dim Oldwidth%
Dim OldHeight%
Dim StartXPer
Dim StartYPer
Dim WidthPer
Dim HeightPer
Dim Startx
Dim StartY
Dim WinRect As RECT
Dim DPoint As POINTAPI
Dim UPoint As POINTAPI
Dim TPoint As POINTAPI
Sub ClearGrip ()
'hide grip (picture8)
    Picture8.Visible = False
End Sub
Sub Command1_click ()
Dim ret    'General return value
'If old Metafile exists then close it so that
'we do not eat memory. Failing to do this would
'mean that the last metafile would be floating
'around in Windows memory with no way  to get rid of it!!
  If GhMF <> 0 Then
    ret = DeleteMetaFile(GhMF)
  End If
'Set the value of the global File name
  If File1 = "" Then
    Exit Sub
  End If
  file = Dir1 & "\" & File1
' Get a metafile Handle for the file
  GhMF = GetDiskMetafile(file)
' If not a metafile then do nothing
  If GhMF = 0 Then
    Exit Sub
  End If
'Turn the file box off and the picture box on
  Picture2.Visible = False
  RestoreWindow
  Picture1.Visible = True
'Draw the Metafile
  Picture1_paint
'remind through cation bar to try resizing
  form1.Caption = form1.Caption & "  RESIZE ME"
End Sub
Sub Command2_Click ()
'turn off about box
   Picture3.Visible = False
   Form_resize
End Sub
Sub Dir1_Change ()
'display files in current directory
  File1 = Dir1
End Sub
Sub Drive1_Change ()
'display  default directory for this drive
  Dir1 = Drive1
End Sub
Sub File1_Click ()
'create full file name string
  file = Dir1 & "\" & File1
End Sub
Sub File1_DblClick ()
'do the same as command1 (Ok)
  Command1_click
End Sub
Sub Form_Activate ()
mnuAbout_click
End Sub
Sub Form_Load ()
'set Caption on title bar
  form1.Caption = "Metafile View & Print"
'Set the drawing mode for playing Metafiles to Ansiotropic
  BoxScale = 8
  mnuAnsi.Checked = True
'Make Picture1 fill the form
  Picture1.Top = form1.ScaleTop
  Picture1.Left = form1.ScaleLeft
  Picture1.Width = form1.ScaleWidth
  Picture1.Height = form1.ScaleHeight
  Picture3.Top = 0
  Picture3.Left = 0
  mnuAbout_click
'display File Window
  mnuOpen_click
End Sub
Sub Form_resize ()
'resize dependant on which window we are currently showing
 If Picture3.Visible = True Then Exit Sub
If Picture1.Visible = True Then
  'resize Picture1
    Picture1.Top = form1.ScaleTop
    Picture1.Left = form1.ScaleLeft
    Picture1.Width = form1.ScaleWidth
    Picture1.Height = form1.ScaleHeight
  'If there is a valid Metafile draw it
    If GhMF = 0 Then
     Else
      Picture1_paint
    End If
End If
If Picture2.Visible = True Then
    'resize form
    form1.Width = Picture2.Width
    form1.Height = Picture2.Height + 750
End If
If Picture4.Visible = True Then
    picture4_resize
End If
End Sub
Sub Form_Unload (Cancel As Integer)
Dim ret
'Close last Metafile before quiting
  ret = DeleteMetaFile(GhMF)
End Sub
Function GetDiskMetafile (FileName$) As Integer
' This Function is Copyright
 P B Dyson 1993
'                              48 Commercial Rd
'                              Skelmanthorpe
'                              Huddersfield
'                              HD8 9DA
'                              England
' Use of this Function is not restricted in any way
' Feel free to include or modify in any way
' If you pass on this Source please leave this Header in.
5 would be welcome if you use this code in one of your programs.
  Dim ret As Long                ' general function return value
  Dim Flen As Long               ' File length
  Dim Address As Long            ' 32 bit memory address
  Dim Head As MetaFileHeader     ' MetaFileHeader structure
  Dim FileNum As Integer         ' VB file number
  Dim hFile As Integer           ' DOS file handle
  Dim hGlobmem As Integer        ' Global memory handle
  Dim hMF As Integer             ' MetaFile handle
' no error handling for a bad filename or bad returns for clarity of method
' A valid filename will return a Metafile handle if it is a
' valid metafile,( either placeable or standard) or 0
' if it not a valid Metafile
' get next free file number
    FileNum = FreeFile
' get file length
    Flen = FileLen(FileName)
' open file
    Open FileName For Binary As FileNum
' strip first 22 bytes to find out if it has a METAFILEHEADER
' structure at the start of the file
     Get FileNum, 1, Head
' get dos file num for API calls that need to access the file
    hFile = FileAttr(FileNum, 2)
'if no placeable header reset pointer to start of file
    If Head.key <> &H9AC6CDD7 Then
        ret = llseek(hFile, 0, 0)        ' could build in  an Exit Fun if failed
    End If
' allocate some memory
    hGlobmem = GlobalAlloc(gmem_moveable, Flen)      ' could build in  an Exit Fun if failed
' stop windows from moving it about while we use it
' and get the address of the memory
    Address = GlobalLock(hGlobmem)               ' could build in  an Exit Fun if failed
' read rest of file into memory
    ret = hread(hFile, Address, Flen)          ' could build in  an Exit Fun if failed
' finished with disk file now
    Close FileNum
' unlock memory back to floating block
' keep Windows happy
    ret = GlobalUnlock(hGlobmem)               ' fatal error if this fails
                                               ' a block of memory is lost but unlikely
' create metafile handle from the memory block
    hMF = SetMetafileBits(hGlobmem)
' If a MetaFile handle is not returned then free the global
' memory block
    If hMF = 0 Then
        ret = GlobalFree(hGlobmem)
    End If
    ' if we return a handle then
    ' memory does not have to be released as it is now a normal
    ' memory metafile and will be released when hMF is finished
    ' with. This MUST be done with DeleteMetaFile() from the
    ' calling program.
' return the handle to the Metafile or 0 if no MetaFile handle
' has been returned
    GetDiskMetafile = hMF
End Function
Sub mnuAbout_click ()
form1.Width = Picture3.Width
form1.Height = Picture3.Height
Picture3.Visible = True
 Form_resize
Picture3.Cls
Picture3.Print "  Created for VB Primer to demonstrate how to speed"
Picture3.Print "  up printing and positioning of graphics in"
Picture3.Print "  Visual Basic using Metafiles. Logos, Graphics"
Picture3.Print "  and converted plotfiles can be displayed on Forms"
Picture3.Print "  and printed quickly at any size."
Picture3.Print ""
Picture3.Print "  If you find this program and source code useful"
Picture3.Print "  please send
5 to:"
Picture3.Print ""
Picture3.Print "      Peter Dyson,100273,656"
Picture3.Print "      48 Commercial Rd,"
Picture3.Print "      Skelmanthorpe,"
Picture3.Print "      Huddersfield,"
Picture3.Print "      HD8 9DA."
Picture3.Print "      England."
Picture3.Print ""
Picture3.Print "  Or mail me some Metafile Handling code of "
Picture3.Print "  similar speed and quality"
End Sub
Sub mnuAnsi_Click ()
'Set mapmode to Ansiotropic
  BoxScale = 8
  mnuAnsi.Checked = True
  mnuIso.Checked = False
'Redraw
  If Picture1.Visible = True Then
     Picture1_paint
   Else
     Picture7_paint
  End If
End Sub
Sub mnuCancel_click ()
'hide shape1
   Shape1.Visible = False
'restore menus
   mnuPrintPar.Visible = False
   mnuCancel.Visible = False
   mnuFile.Enabled = True
   mnuDisplay.Enabled = True
   form1.Caption = "Metafile View & Print"
'Restore picture1
  Picture4.Visible = False
  RestoreWindow
  Picture1.Visible = True
  Picture1_paint
End Sub
Sub mnuExit_Click ()
  End      'Quit
End Sub
Sub mnuFull_Click ()
'Declarations
  Dim hDC1 As Integer
  Dim di%
  Dim dl&
  Dim savedDC As Integer
'turn on hourglass
  Screen.MousePointer = 11
'prepare Printer for metafile
   'Turn on printer object by printing space
     Printer.ScaleMode = 1
     Printer.Print ""
   'Set Printer object scalemode to Pixel
     Printer.ScaleMode = 3
     hDC1 = Printer.hDC
   'save dc attributes for Printer
     savedDC = SaveDC(Printer.hDC)
   ' more picture preparations which change the DC of the control
     di% = SetMapMode(hDC1, BoxScale)
     dl& = SetViewPortExt(hDC1, Printer.ScaleWidth, Printer.ScaleHeight)
   ' and finally play the metafile into the Printer object
     di% = PlayMetaFile(hDC1, GhMF)
   'restore original DC attributes
     di% = RestoreDC(hDC1, savedDC)
   'Tell the Printer to print this page
     Printer.EndDoc
'printing finished
'turn on normal cursor
    Screen.MousePointer = 0
End Sub
Sub mnuIso_Click ()
'Set mapmode to Isotropic
  BoxScale = 7
  mnuIso.Checked = True
  mnuAnsi.Checked = False
'Redraw
  If Picture1.Visible = True Then
     Picture1_paint
   Else
     Picture7_paint
  End If
End Sub
Sub mnuOpen_click ()
'Make the File Box visible. (Not Windows standard
'but enables people with VB Primer to use this)
  SaveWindow
  'turn off picture1
  Picture1.Visible = False
  'resize form
  form1.Width = Picture2.Width
  form1.Height = Picture2.Height + 750
  'display file box
  Picture2.Visible = True
  'show caption
  form1.Caption = "Metafile View & Print"
End Sub
Sub mnuPrintPar_Click ()
'Declarations
  Dim hDC1 As Integer
  Dim di%
  Dim dl&
  Dim savedDC As Integer
'turn on hourglass
    Screen.MousePointer = 11
  'work out the start points in percentage terms of page x,y
      StartXPer = Picture7.Left / Picture6.ScaleWidth
      StartYPer = Picture7.Top / Picture6.ScaleHeight
  'work out width and height
      WidthPer = Picture7.Width / Picture6.ScaleWidth
      HeightPer = Picture7.Height / Picture6.ScaleHeight
'prepare Printer for metafile
   'Turn on printer object by printing space
     Printer.ScaleMode = 1
     Printer.Print ""
'Set Printer object scalemode to Pixel
    Printer.ScaleMode = 3
    hDC1 = Printer.hDC
' save dc attributes for Printer
    savedDC = SaveDC(Printer.hDC)
' more picture preparations which change the DC of the control
    di% = SetMapMode(hDC1, BoxScale)
    dl& = SetViewPortExt(hDC1, Printer.ScaleWidth * WidthPer, Printer.ScaleHeight * HeightPer)
    dl& = setviewportorg(hDC1, Printer.ScaleWidth * StartXPer, Printer.ScaleHeight * StartYPer)
' and finally play the metafile into the Printer object
    di% = PlayMetaFile(hDC1, GhMF)
'restore original DC attributes
    di% = RestoreDC(hDC1, savedDC)
'Tell the Printer to print this page
   Printer.EndDoc
'Reset the form and pointer to what they were before
   Screen.MousePointer = 0
   mnuCancel_click
End Sub
Sub mnuSel_Click ()
  SaveWindow
'clear everything from form
  Picture1.Visible = False
  Picture2.Visible = False
'change caption bar as prompt
  form1.Caption = "Draw Box and Print"
   picture4_resize
  'turn page on
  Picture4.Visible = True
  'initialise boundary box
  Shape1.Visible = True
  Picture6_MouseDown 1, 0, 1, 1
  Shape1.Visible = False
  'do not display metafile picture or grip
  Picture7.Visible = False
  Picture8.Visible = False
End Sub
Sub Picture1_paint ()
'fill picture1 with the metafile
  PlayMetafileFull Picture1, GhMF
End Sub
Sub picture4_resize ()
'resize form to look like portrait paper
  form1.Width = form1.ScaleHeight * 8.5 / 12
'Enable Print Part and Cancel in menubar
   mnuPrintPar.Visible = True
   mnuCancel.Visible = True
   mnuFile.Enabled = False
'Set sizes of picture boxes to current form size
  'background
  Picture4.Top = 0
  Picture4.Left = 0
  Picture4.Width = form1.ScaleWidth
  Picture4.Height = form1.ScaleHeight
  'shadow
  Picture5.Top = Picture4.ScaleHeight * .05
  Picture5.Left = Picture4.ScaleWidth * .05
  Picture5.Width = Picture4.ScaleWidth * .9
  Picture5.Height = Picture4.ScaleHeight * .9
  'page
  Picture6.Top = Picture5.Top - 60
  Picture6.Left = Picture5.Left - 60
  Picture6.Width = Picture5.Width
  Picture6.Height = Picture5.Height
End Sub
Sub Picture6_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
'this is an example of how to confine the cursor to a specified
'control and how to create a rubberband box
  If Picture7.Visible = True Then
    Exit Sub
  End If
  'clear page

     Picture7.Visible = False
     ClearGrip
  'Set starting points
     Shape1.Left = x
     Shape1.Top = y
     Shape1.Width = 1
     Shape1.Height = 1
     Shape1.Visible = True
  'keep start points

      Startx = x
      StartY = y
' Get boundarys of picture box in screen coords
' set the clipping rectangle for picture6 to hold the cursor.
' Just these two commands and the ClipCursorClear (type safe variant
' of ClipCursor) in mouse_up is all that is needed to create a bounding
' box from which the cursor cannot be moved out of.
    GetWindowRect Picture6.hWnd, WinRect       'API
    ClipCursor WinRect                         'API
End Sub
Sub Picture6_Mousemove (Button As Integer, Shift As Integer, x As Single, y As Single)
  If Picture7.Visible = True Then
    Exit Sub
  End If
'only process if left mouse button is down
  If Button = 1 Then

  'get width and height of box
     Shape1.Width = (Abs(x - Startx)) + 1
     Shape1.Height = (Abs(y - StartY)) + 1
  ' if current x is to the left of start point change box orgin
      If Startx > x Then
        Shape1.Left = x
       Else
        Shape1.Left = Startx
      End If
   ' if current y is above the start point change box orgin
      If StartY > y Then
        Shape1.Top = y
       Else
        Shape1.Top = StartY
      End If
  End If
End Sub
Sub Picture6_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
  If Picture7.Visible = True Then
    Exit Sub
  End If
' clear the cursor clipping rectangle to allow normal
' cursor actions to take place
    ClipCursorClear 0              ' API
  'resize picture to shape
    Picture7.Visible = True
    Picture7.Top = Shape1.Top
    Picture7.Left = Shape1.Left
    Picture7.Width = Shape1.Width
    Picture7.Height = Shape1.Height
  'prepare Picture7 for metafile
     Shape1.Visible = False
     PlayMetafileFull Picture7, GhMF
     SetGrip
End Sub
Sub Picture7_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
'an example of how to ensure that a graghic object stays
'within the boundarys of another object. Also demonstrates
'how to convert a point selected from one coordinate system
'to the same point in a window underneath using a different coordinate
'system.
 Dim page As RECT
 Dim pic1 As RECT
 Dim clip As RECT
 Dim temp As POINTAPI
MousePointer = 5
'turn off grip
   ClearGrip
'convert points at POINTAPI struct
   DPoint.x = x
   DPoint.y = y
'find the pixel coords for down point for picture6
   MapWindowPoints Picture7.hWnd, Picture6.hWnd, DPoint, 1
'keep original left and top of picture
   TPoint.x = Picture7.Left
   TPoint.y = Picture7.Top
' get screen area of page and picture (pixels)
    GetWindowRect Picture6.hWnd, page  'screen coord of page
    GetWindowRect Picture7.hWnd, pic1  'screen coord of picture
'get point of mousedown in screen coord
   temp = DPoint                       'need dpoint in pic6 coords later
   clienttoscreen Picture6.hWnd, temp  'now got mousedown in screen coords
'calculate clipping region
   clip.Top = page.Top + (temp.y - pic1.Top)
   clip.Left = page.Left + (temp.x - pic1.Left)
   clip.Bottom = page.Bottom - (pic1.Bottom - temp.y)
   clip.Right = page.Right - (pic1.Right - temp.x)
'set clipping action
   ClipCursor clip
End Sub
Sub Picture7_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
'only process if leftmouse button is down
  If Button = 1 Then
    'put x,y in picture7 coord into POINAPI struct
     UPoint.x = x
     UPoint.y = y
   'find the Picture6 coords for this down point
     MapWindowPoints Picture7.hWnd, Picture6.hWnd, UPoint, 1
   'calculate new picture position in picture 6 coords
     Picture7.Top = TPoint.y + (UPoint.y - DPoint.y)
     Picture7.Left = TPoint.x + (UPoint.x - DPoint.x)
  End If
End Sub
Sub Picture7_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
'free up the cursor to move anywhere
   ClipCursorClear 0
'put x,y in picture7 coord into POINAPI struct
     UPoint.x = x
     UPoint.y = y
'find the Picture6 coords for this  point
     MapWindowPoints Picture7.hWnd, Picture6.hWnd, UPoint, 1
'calculate new picture position in picture 6 coords
     Picture7.Top = TPoint.y + (UPoint.y - DPoint.y)
     Picture7.Left = TPoint.x + (UPoint.x - DPoint.x)
'display the grip point
   SetGrip
   MousePointer = 0
End Sub
Sub Picture7_paint ()
'fill picture7 with the metafile
   PlayMetafileFull Picture7, GhMF
End Sub
Sub Picture8_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
'a further example of how to use coordinate transformation
 Dim page As RECT
 Dim pic1 As RECT
 Dim clip As RECT
'ensure picture6 scalemode is set to pixels
   Picture6.ScaleMode = 3
  'clear page

     Picture7.Visible = False

  'Set starting points
     Shape1.Left = Picture7.Left
     Shape1.Top = Picture7.Top
     Shape1.Width = Picture8.Left - Picture7.Left + 3
     Shape1.Height = Picture8.Top - Picture7.Top + 3
     Shape1.Visible = True
  'keep start points

      Startx = Picture7.Left
      StartY = Picture7.Top
' Get boundarys of page box in screen coords
' Get boundarys of picture in screen coords
    GetWindowRect Picture6.hWnd, page       'API
    GetWindowRect Picture7.hWnd, pic1      'API
' set limits of cursor to picture top left
'                         page bottom right
    clip.Top = pic1.Top + 10          'not too small
    clip.Left = pic1.Left + 10        '10 by 10 pixels min
    clip.Bottom = page.Bottom
    clip.Right = page.Right
    ClipCursor clip                         'API
End Sub
Sub Picture8_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
'only process if left mouse button is down
  If Button = 1 Then
UPoint.x = x
UPoint.y = y
'find the page coords for down point
 MapWindowPoints Picture8.hWnd, Picture6.hWnd, UPoint, 1
     Shape1.Width = (Abs(UPoint.x - Startx)) + 1
     Shape1.Height = (Abs(UPoint.y - StartY)) + 1
'move the grip
     Picture8.Top = Shape1.Height + StartY - 4
     Picture8.Left = Shape1.Width + Startx - 4
  End If
End Sub
Sub Picture8_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
' clear the cursor clipping rectangle to allow normal
' cursor actions to take place
    ClipCursorClear 0              ' API
  'resize picture to shape
    Picture7.Top = Shape1.Top
    Picture7.Left = Shape1.Left
    Picture7.Width = Shape1.Width
    Picture7.Height = Shape1.Height
'prepare Picture7 for metafile

      Shape1.Visible = False
      Picture7.Visible = True
      PlayMetafileFull Picture7, GhMF
    SetGrip
End Sub
Sub PlayMetafileFull (Pict As Control, hMF As Integer)
  Dim hDC1 As Integer
  Dim di%
  Dim dl&
  Dim savedDC As Integer

  If Pict.Width > 3 Then
     Pict.Cls
     Pict.AutoRedraw = False
     Pict.ScaleMode = 3
     hDC1 = Pict.hDC
' save dc attributes for picture
    savedDC = SaveDC(Pict.hDC)
' more picture preparations which change the DC of the control
    di% = SetMapMode(hDC1, BoxScale)
    dl& = SetViewPortExt(hDC1, Pict.ScaleWidth, Pict.ScaleHeight)
' and finally play the metafile into the picture
    di% = PlayMetaFile(hDC1, hMF)
'restore original DC attributes
    di% = RestoreDC(hDC1, savedDC)
    Pict.AutoRedraw = True
End If
End Sub
 Sub RestoreWindow ()
'Restore size
  form1.ScaleMode = OldMode
  form1.Width = Oldwidth
  form1.Height = OldHeight
End Sub
 Sub SaveWindow ()
'Save current form properties
  OldMode = form1.ScaleMode
  Oldwidth = form1.Width
  OldHeight = form1.Height
End Sub
Sub SetGrip ()
  Picture8.Top = Picture7.Top + Picture7.Height - 3
  Picture8.Left = Picture7.Left + Picture7.Width - 3
  Picture8.Visible = True
End Sub