home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch08 / quikdraw.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  25.2 KB  |  711 lines

  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
  3. Begin VB.Form QuikDraw 
  4.    Appearance      =   0  'Flat
  5.    BackColor       =   &H80000005&
  6.    Caption         =   "QuikDraw"
  7.    ClientHeight    =   4245
  8.    ClientLeft      =   1110
  9.    ClientTop       =   1770
  10.    ClientWidth     =   7365
  11.    BeginProperty Font 
  12.       Name            =   "MS Sans Serif"
  13.       Size            =   8.25
  14.       Charset         =   0
  15.       Weight          =   700
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    LinkMode        =   1  'Source
  22.    LinkTopic       =   "Form1"
  23.    PaletteMode     =   1  'UseZOrder
  24.    ScaleHeight     =   4245
  25.    ScaleWidth      =   7365
  26.    Begin VB.HScrollBar ScrollObject 
  27.       Height          =   255
  28.       Index           =   4
  29.       Left            =   5400
  30.       Max             =   9
  31.       TabIndex        =   16
  32.       Top             =   3840
  33.       Value           =   1
  34.       Width           =   495
  35.    End
  36.    Begin VB.CheckBox ChkPoly 
  37.       Appearance      =   0  'Flat
  38.       BackColor       =   &H80000005&
  39.       Caption         =   "PolyMode WINDING"
  40.       ForeColor       =   &H80000008&
  41.       Height          =   255
  42.       Left            =   1800
  43.       TabIndex        =   18
  44.       Top             =   3840
  45.       Width           =   2175
  46.    End
  47.    Begin VB.CommandButton CmdShowMF 
  48.       Appearance      =   0  'Flat
  49.       BackColor       =   &H80000005&
  50.       Caption         =   "ShowMF"
  51.       Height          =   495
  52.       Left            =   120
  53.       TabIndex        =   6
  54.       Top             =   3720
  55.       Width           =   1095
  56.    End
  57.    Begin VB.HScrollBar ScrollObject 
  58.       Height          =   255
  59.       Index           =   3
  60.       Left            =   6000
  61.       Max             =   7
  62.       Min             =   -1
  63.       TabIndex        =   11
  64.       Top             =   3480
  65.       Value           =   6
  66.       Width           =   495
  67.    End
  68.    Begin VB.HScrollBar ScrollObject 
  69.       Height          =   255
  70.       Index           =   2
  71.       Left            =   5400
  72.       Max             =   5
  73.       Min             =   -1
  74.       TabIndex        =   10
  75.       Top             =   3480
  76.       Width           =   495
  77.    End
  78.    Begin VB.HScrollBar ScrollObject 
  79.       Height          =   255
  80.       Index           =   1
  81.       Left            =   6000
  82.       Max             =   16
  83.       Min             =   -1
  84.       TabIndex        =   9
  85.       Top             =   3120
  86.       Value           =   15
  87.       Width           =   495
  88.    End
  89.    Begin VB.HScrollBar ScrollObject 
  90.       Height          =   255
  91.       Index           =   0
  92.       Left            =   5400
  93.       Max             =   16
  94.       Min             =   -1
  95.       TabIndex        =   8
  96.       Top             =   3120
  97.       Width           =   495
  98.    End
  99.    Begin VB.PictureBox Picture3 
  100.       Appearance      =   0  'Flat
  101.       BackColor       =   &H80000005&
  102.       ForeColor       =   &H80000008&
  103.       Height          =   975
  104.       Left            =   4080
  105.       ScaleHeight     =   945
  106.       ScaleWidth      =   1185
  107.       TabIndex        =   7
  108.       Top             =   3120
  109.       Width           =   1215
  110.    End
  111.    Begin VB.CommandButton CmdDeleteMF 
  112.       Appearance      =   0  'Flat
  113.       BackColor       =   &H80000005&
  114.       Caption         =   "DeleteMF"
  115.       Height          =   495
  116.       Left            =   1320
  117.       TabIndex        =   5
  118.       Top             =   3120
  119.       Width           =   975
  120.    End
  121.    Begin VB.CommandButton CmdExecute 
  122.       Appearance      =   0  'Flat
  123.       BackColor       =   &H80000005&
  124.       Caption         =   "AddToMF"
  125.       Height          =   495
  126.       Index           =   2
  127.       Left            =   120
  128.       TabIndex        =   4
  129.       Top             =   3120
  130.       Width           =   1095
  131.    End
  132.    Begin VB.PictureBox Picture2 
  133.       Appearance      =   0  'Flat
  134.       BackColor       =   &H80000005&
  135.       ForeColor       =   &H80000008&
  136.       Height          =   1095
  137.       Left            =   5760
  138.       ScaleHeight     =   71
  139.       ScaleMode       =   3  'Pixel
  140.       ScaleWidth      =   71
  141.       TabIndex        =   3
  142.       Top             =   1440
  143.       Width           =   1095
  144.    End
  145.    Begin VB.CommandButton CmdExecute 
  146.       Appearance      =   0  'Flat
  147.       BackColor       =   &H80000005&
  148.       Caption         =   "SmallView"
  149.       Height          =   495
  150.       Index           =   1
  151.       Left            =   5760
  152.       TabIndex        =   2
  153.       Top             =   840
  154.       Width           =   1095
  155.    End
  156.    Begin VB.CommandButton CmdExecute 
  157.       Appearance      =   0  'Flat
  158.       BackColor       =   &H80000005&
  159.       Caption         =   "Execute"
  160.       Height          =   495
  161.       Index           =   0
  162.       Left            =   5760
  163.       TabIndex        =   1
  164.       Top             =   240
  165.       Width           =   1095
  166.    End
  167.    Begin VB.PictureBox Picture1 
  168.       Appearance      =   0  'Flat
  169.       BackColor       =   &H80000005&
  170.       ForeColor       =   &H80000008&
  171.       Height          =   2895
  172.       Left            =   120
  173.       ScaleHeight     =   191
  174.       ScaleMode       =   3  'Pixel
  175.       ScaleWidth      =   319
  176.       TabIndex        =   0
  177.       Top             =   120
  178.       Width           =   4815
  179.    End
  180.    Begin MSComDlg.CommonDialog CMDialogMF 
  181.       Left            =   3360
  182.       Top             =   3120
  183.       _ExtentX        =   847
  184.       _ExtentY        =   847
  185.       _Version        =   327680
  186.       Filter          =   "Metafiles (*.wmf)|*.wmf"
  187.       Flags           =   4100
  188.       FontSize        =   2.54016e-29
  189.    End
  190.    Begin VB.Label Label5 
  191.       Appearance      =   0  'Flat
  192.       BackColor       =   &H80000005&
  193.       Caption         =   "Width"
  194.       ForeColor       =   &H80000008&
  195.       Height          =   255
  196.       Left            =   6600
  197.       TabIndex        =   17
  198.       Top             =   3840
  199.       Width           =   615
  200.    End
  201.    Begin VB.Label Label4 
  202.       Appearance      =   0  'Flat
  203.       BackColor       =   &H80000005&
  204.       Caption         =   "Style"
  205.       ForeColor       =   &H80000008&
  206.       Height          =   255
  207.       Left            =   6600
  208.       TabIndex        =   15
  209.       Top             =   3480
  210.       Width           =   615
  211.    End
  212.    Begin VB.Label Label3 
  213.       Appearance      =   0  'Flat
  214.       BackColor       =   &H80000005&
  215.       Caption         =   "Color"
  216.       ForeColor       =   &H80000008&
  217.       Height          =   255
  218.       Left            =   6600
  219.       TabIndex        =   14
  220.       Top             =   3120
  221.       Width           =   615
  222.    End
  223.    Begin VB.Label Label2 
  224.       Appearance      =   0  'Flat
  225.       BackColor       =   &H80000005&
  226.       Caption         =   "Brush"
  227.       ForeColor       =   &H80000008&
  228.       Height          =   255
  229.       Left            =   6000
  230.       TabIndex        =   13
  231.       Top             =   2760
  232.       Width           =   615
  233.    End
  234.    Begin VB.Label Label1 
  235.       Appearance      =   0  'Flat
  236.       BackColor       =   &H80000005&
  237.       Caption         =   "Pen"
  238.       ForeColor       =   &H80000008&
  239.       Height          =   255
  240.       Left            =   5400
  241.       TabIndex        =   12
  242.       Top             =   2760
  243.       Width           =   495
  244.    End
  245.    Begin VB.Menu MenuDraw 
  246.       Caption         =   "Draw"
  247.       Begin VB.Menu MenuDrawType 
  248.          Caption         =   "Line"
  249.          Checked         =   -1  'True
  250.          Index           =   0
  251.       End
  252.       Begin VB.Menu MenuDrawType 
  253.          Caption         =   "Ellipse"
  254.          Index           =   1
  255.       End
  256.       Begin VB.Menu MenuDrawType 
  257.          Caption         =   "FocusRect"
  258.          Index           =   2
  259.       End
  260.       Begin VB.Menu MenuDrawType 
  261.          Caption         =   "Chord"
  262.          Index           =   3
  263.       End
  264.       Begin VB.Menu MenuDrawType 
  265.          Caption         =   "Pie"
  266.          Index           =   4
  267.       End
  268.       Begin VB.Menu MenuDrawType 
  269.          Caption         =   "Arc"
  270.          Index           =   5
  271.       End
  272.       Begin VB.Menu MenuDrawType 
  273.          Caption         =   "Polygon"
  274.          Index           =   6
  275.       End
  276.       Begin VB.Menu MenuDrawType 
  277.          Caption         =   "Polyline"
  278.          Index           =   7
  279.       End
  280.       Begin VB.Menu MenuDrawType 
  281.          Caption         =   "Rectangle"
  282.          Index           =   8
  283.       End
  284.    End
  285.    Begin VB.Menu mnu_Metafile 
  286.       Caption         =   "Metafile"
  287.       Begin VB.Menu mnu_MetafileSave 
  288.          Caption         =   "Save"
  289.       End
  290.       Begin VB.Menu mnu_MetafileLoad 
  291.          Caption         =   "Load"
  292.       End
  293.       Begin VB.Menu mnu_MetafileCopy 
  294.          Caption         =   "Copy to Clipboard"
  295.       End
  296.    End
  297. Attribute VB_Name = "QuikDraw"
  298. Attribute VB_GlobalNameSpace = False
  299. Attribute VB_Creatable = False
  300. Attribute VB_PredeclaredId = True
  301. Attribute VB_Exposed = False
  302. DefStr A-Z
  303. Option Explicit
  304. ' Copyright 
  305.  1997 by Desaware Inc. All Rights Reserved
  306. ' Delete the current metafile
  307. Private Sub CmdDeleteMF_Click()
  308.     Dim di& ' Change to long - will work in Win16 too.
  309.     If hndMetaFile Then
  310.         di = DeleteMetaFile(hndMetaFile)
  311.         hndMetaFile = 0
  312.     End If
  313. End Sub
  314. '   Draw the current object on the picture
  315. '   Index = 0 is the Execute button which draws the current
  316. '   object into the large Picture1 control
  317. '   Index = 1 is the SmallView button which draws the
  318. '   current object into the small Picture2 control
  319. '   Index = 2 is the AddToMF button which adds the current
  320. '   object into the current metafile.
  321. Private Sub CmdExecute_Click(Index As Integer)
  322.     #If Win32 Then
  323.         Dim dc&, saved&, di&, dl&
  324.         Dim oldpen&, oldbrush&, oldpolymode&
  325.     #Else
  326.         Dim dc%, saved%, di%, dl&
  327.         Dim oldpen%, oldbrush%, oldpolymode%
  328.     #End If
  329.     Dim rc As RECT
  330.     Dim oldsize As SIZE
  331.     Dim oldpoint As POINTAPI
  332.     Select Case Index
  333.         Case 0  ' Execute button - draw into Picture1 after
  334.                 ' clearing the control.
  335.             dc = Picture1.hDC
  336.             Picture1.Cls
  337.         Case 1  ' SmallView button - draw into Picture2
  338.             Picture2.Cls
  339.             dc = Picture2.hDC
  340.             ' We're going to be changing the scaling, better
  341.             ' save the current state of the DC or the VB
  342.             ' drawing routines will no longer draw correctly.
  343.             saved = SaveDC(dc)
  344.             ' The entire area of Picture1 is scaled to fit
  345.             ' Picture2 exactly - this requires a change of
  346.             ' the mapping mode.
  347.             di = SetMapMode(dc, MM_ANISOTROPIC)
  348.             
  349.             ' The logical window is the size of Picture1.
  350.             ' Mapping this to the area of Picture2 is done
  351.             ' by making all of Picture2 the viewport.
  352.             dl& = SetWindowExtEx(dc, Picture1.ScaleWidth, Picture1.ScaleHeight, oldsize)
  353.             dl& = SetViewportExtEx(dc, Picture2.ScaleWidth, Picture2.ScaleHeight, oldsize)
  354.         Case 2  ' AddToMeta button - Add the current object
  355.                 ' to the global metafile.
  356.             ' First create a new metafile device context.
  357.             dc = CreateMetaFile(vbNullString)
  358.             If hndMetaFile <> 0 Then
  359.                 ' If a global metafile already exists,
  360.                 ' first the existing metafile into the new one.
  361.                 di = PlayMetaFile(dc, hndMetaFile)
  362.                 ' Then delete the existing metafile.
  363.                 di = DeleteMetaFile(hndMetaFile)
  364.                 hndMetaFile = 0
  365.                 ' The drawing commands that follow will add
  366.                 ' the current object to the new metafile
  367.                 ' device context.
  368.                 End If
  369.         End Select
  370.     ' Select in the private pen and brush if we're using them
  371.     If hndPen <> 0 And hndBrush <> 0 Then
  372.         oldpen = SelectObject(dc, hndPen)
  373.         oldbrush = SelectObject(dc, hndBrush)
  374.         End If
  375.     ' Also change the polygon filling mode to winding if necessary
  376.     If ChkPoly.value = 1 Then oldpolymode = SetPolyFillMode(dc, WINDING)
  377.     ' The object drawn depends on global LastDrawIndex which
  378.     ' was set by the Draw menu commands.
  379.     ' The PointsUsed global indicates how many points have
  380.     ' been drawn in Picture1.
  381.     Select Case LastDrawIndex
  382.         Case 0  ' Draw a line
  383.             If PointsUsed = 2 Then
  384.                 ' Set the current position of the pen
  385.                 dl = MoveToEx(dc, PointArray(0).x, PointArray(0).y, oldpoint)
  386.                 ' and draw to the specified point.
  387.                 di = LineTo(dc, PointArray(1).x, PointArray(1).y)
  388.                 End If
  389.         Case 1  ' Draw an ellipse
  390.             If PointsUsed% = 2 Then
  391.                 di = Ellipse(dc, PointArray(0).x, PointArray(0).y, PointArray(1).x, PointArray(1).y)
  392.                 End If
  393.         Case 2 ' Draw a focus rectangle
  394.             If PointsUsed% = 2 Then
  395.                 SetRect rc, PointArray(0).x, PointArray(0).y, PointArray(1).x, PointArray(1).y
  396.                 DrawFocusRect dc, rc
  397.                 End If
  398.         Case 3  ' Draw a chord
  399.             If PointsUsed% = 4 Then
  400.                 di = Chord(dc, PointArray(0).x, PointArray(0).y, PointArray(1).x, PointArray(1).y, PointArray(2).x, PointArray(2).y, PointArray(3).x, PointArray(3).y)
  401.                 End If
  402.         Case 4  ' Draw a pie
  403.             If PointsUsed% = 4 Then
  404.                 di = Pie(dc, PointArray(0).x, PointArray(0).y, PointArray(1).x, PointArray(1).y, PointArray(2).x, PointArray(2).y, PointArray(3).x, PointArray(3).y)
  405.                 End If
  406.         Case 5  ' Draw an arc
  407.             If PointsUsed% = 4 Then
  408.                 di = Arc(dc, PointArray(0).x, PointArray(0).y, PointArray(1).x, PointArray(1).y, PointArray(2).x, PointArray(2).y, PointArray(3).x, PointArray(3).y)
  409.                 End If
  410.         Case 6 ' Draw a polygon
  411.             If PointsUsed% > 1 Then
  412.                 di = Polygon(dc, PointArray(0), PointsUsed%)
  413.                 End If
  414.         Case 7 ' Draw a polyline
  415.             If PointsUsed% > 1 Then
  416.                 di = Polyline(dc, PointArray(0), PointsUsed%)
  417.                 End If
  418.         Case 8 ' Draw a rectangle
  419.             If PointsUsed% = 2 Then
  420.                 di = Rectangle(dc, PointArray(0).x, PointArray(0).y, PointArray(1).x, PointArray(1).y)
  421.                 End If
  422.         End Select
  423.     ' Be sure to restore the original GDI objects!
  424.     If oldpen <> 0 Then di = SelectObject(dc, oldpen)
  425.     If oldbrush <> 0 Then di = SelectObject(dc, oldbrush)
  426.     If ChkPoly.value = 1 Then di = SetPolyFillMode(dc, oldpolymode)
  427.     Select Case Index
  428.         Case 0
  429.             ' Notify the mouse down routine that the last
  430.             ' command was an execute
  431.             ' This informs the system that the next mouse
  432.             ' click in Picture1 is the start of a new object.
  433.             LastWasExecute% = -1
  434.         Case 1  ' Restore the previous state of the Picture2 DC
  435.             di = RestoreDC(dc, saved)
  436.         Case 2  ' Close the metafile device context and
  437.                 ' objtain a metafile handle.
  438.             hndMetaFile = CloseMetaFile(dc)
  439.             dc = Picture1.hDC
  440.         End Select
  441. End Sub
  442. ' Show the current global metafile if one exists. It will
  443. '   be shown in both Picture1 and Picture2
  444. ' Porting notes:
  445. '   Conditionally define the variabe types.
  446. '   Removed type characters % and & from variable usage to avoid
  447. '       conflicts between 16 and 32 bits environments
  448. '   Changed SetViewportEx and SetWindowExt to SetViewportExtEx and
  449. '       SetWindowExtEx for Win32 compatibility.
  450. Private Sub CmdShowMF_Click()
  451.     #If Win32 Then
  452.         Dim saved&, dc&, di&, dl&
  453.     #Else
  454.         Dim saved%, dc%, di%, dl&
  455.     #End If
  456.     Dim oldsize As SIZE
  457.     ' Because the original drawing was into Picture1,
  458.     ' playing the metafile into Picture1 is trivial.
  459.     Picture1.Cls
  460.     di = PlayMetaFile(Picture1.hDC, hndMetaFile)
  461.     ' Picture 2 is trickier. First we clear it and save the
  462.     ' current DC state.
  463.     Picture2.Cls
  464.     dc = Picture2.hDC
  465.     saved = SaveDC(dc)
  466.     ' Now set the new coordinate system. See the CmdExecute()_Click
  467.     ' command for further explanation
  468.     di = SetMapMode(dc, MM_ANISOTROPIC)
  469.     dl = SetWindowExtEx(dc, Picture1.ScaleWidth, Picture1.ScaleHeight, oldsize)
  470.     dl = SetViewportExtEx(dc, Picture2.ScaleWidth, Picture2.ScaleHeight, oldsize)
  471.     ' All of the drawing objects that were used on the original
  472.     ' objects were saved with the metafile, thus the metafile
  473.     ' will automatically draw each object in the correct color
  474.     ' and style.
  475.     di = PlayMetaFile(dc, hndMetaFile)
  476.     ' And restore the original DC state
  477.     di = RestoreDC(dc, saved)
  478. End Sub
  479. ' We default to the line mode with no points defined.
  480. Private Sub Form_Load()
  481.     MaxPoints% = 2
  482.     PointsUsed% = 0
  483.     ' Force the selection of a valid pen and brush
  484.     ScrollObject_Change 0
  485. End Sub
  486. '   It is important to delete these GDI objects (if they
  487. '   were created) before closing the application so that
  488. '   the Windows resources may be properly freed.
  489. Private Sub Form_Unload(Cancel As Integer)
  490.     Dim di&
  491.     If hndMetaFile <> 0 Then di = DeleteMetaFile(hndMetaFile)
  492.     If hndPen <> 0 Then di = DeleteObject(hndPen)
  493.     If hndBrush <> 0 Then di = DeleteObject(hndBrush)
  494. End Sub
  495. '   This function handles the menu commands. Each one defines
  496. '   a different object to draw when the Execute command button
  497. '   is selected.
  498. Private Sub MenuDrawType_Click(Index As Integer)
  499.     Dim x%
  500.     ' Clear out the current object.
  501.     PointsUsed% = 0
  502.     Picture1.Cls
  503.     ' LastDrawIndex is a global that shows which GDI drawing
  504.     ' function is being tested.
  505.     LastDrawIndex% = Index
  506.     ' Uncheck all of the menu entries
  507.     For x% = 0 To 8
  508.         MenuDrawType(x%).Checked = 0
  509.         Next x%
  510.     ' And check this one only.
  511.     MenuDrawType(Index).Checked = -1
  512.     ' Each GDI drawing tool has a maximum number of points
  513.     ' that it needs in order to perform the drawing.
  514.     Select Case Index
  515.         Case 0, 1, 2, 8
  516.             MaxPoints% = 2
  517.         Case 3, 4, 5
  518.             MaxPoints% = 4
  519.         ' Polygons are limited to the size of the point data array
  520.         Case 6, 7
  521.             MaxPoints% = 32
  522.         End Select
  523. End Sub
  524. Private Sub mnu_MetafileCopy_Click()
  525.     #If Win32 Then
  526.         Dim hdcMeta&
  527.         Dim dl&, di&
  528.         Dim newmf&
  529.         Dim hgmem&
  530.     #Else
  531.         Dim hdcMeta%
  532.         Dim dl&, di%
  533.         Dim newmf%
  534.         Dim hgmem%
  535.     #End If
  536.     Dim mfp As METAFILEPICT
  537.     Dim GlblAddr&
  538.     Dim oldsize As SIZE
  539.     If hndMetaFile = 0 Then
  540.         MsgBox "Metafile must be defined before saving"
  541.         Exit Sub
  542.     End If
  543.     hdcMeta = CreateMetaFile(vbNullString)
  544.     dl& = SetWindowExtEx(hdcMeta, Picture1.ScaleWidth, Picture1.ScaleHeight, oldsize)
  545.     di = PlayMetaFile(hdcMeta, hndMetaFile)
  546.     newmf = CloseMetaFile(hdcMeta)
  547.     mfp.mm = MM_ANISOTROPIC
  548.     mfp.xExt = Picture1.ScaleWidth
  549.     mfp.yExt = Picture1.ScaleHeight
  550.     mfp.hMF = newmf
  551.     ' Take out hardcoded sizes - used to be 8 instead of len(mfp)
  552.     hgmem = GlobalAlloc(GMEM_MOVEABLE, Len(mfp))
  553.     GlblAddr = GlobalLock(hgmem)
  554.     agCopyData mfp, ByVal GlblAddr&, Len(mfp)
  555.     di = GlobalUnlock(hgmem)
  556.     ' Place the metafile into the clipboard
  557.     di = OpenClipboard(Picture1.hwnd)
  558.     di = EmptyClipboard()
  559.     di = SetClipboardData(CF_METAFILEPICT, hgmem)
  560.     di = CloseClipboard()
  561. End Sub
  562. Private Sub mnu_MetafileLoad_Click()
  563.     Dim usefile$
  564.     #If Win32 Then
  565.         Dim saved&
  566.         Dim dc&
  567.         Dim usemf&
  568.         Dim di&, dl&
  569.     #Else
  570.         Dim saved%
  571.         Dim dc%
  572.         Dim usemf%
  573.         Dim di%, dl&
  574.     #End If
  575.     Dim oldsize As SIZE
  576.     CMDialogMF.DialogTitle = "Load a metafile"
  577.     CMDialogMF.Action = 1
  578.     usefile$ = CMDialogMF.FileName
  579.     If usefile$ <> "" Then
  580.         usemf = LoadTheMetafile(usefile$)
  581.         If usemf <> 0 Then
  582.             ' Now draw the metafile
  583.             Picture1.Cls
  584.             dc = Picture1.hDC
  585.             saved = SaveDC(dc)
  586.             ' Now set the new coordinate system. See the CmdExecute()_Click
  587.             ' command for further explanation
  588.             ' Most metafiles will set their own extents, but we need
  589.             ' to set the viewport to match the scalemode of the
  590.             ' entire screen to fill the window
  591.             di = SetMapMode(dc, MM_ANISOTROPIC)
  592.             dl = SetViewportExtEx(dc, Picture1.ScaleWidth, Picture1.ScaleHeight, oldsize)
  593.             ' All of the drawing objects that were used on the original
  594.             ' objects were saved with the metafile, thus the metafile
  595.             ' will automatically draw each object in the correct color
  596.             ' and style.
  597.             di = PlayMetaFile(dc, usemf)
  598.             ' And restore the original DC state
  599.             di = RestoreDC(dc, saved)
  600.             di = DeleteMetaFile(usemf)
  601.         End If
  602.     End If
  603. End Sub
  604. Private Sub mnu_MetafileSave_Click()
  605.     Dim di&
  606.     Dim usefile$
  607.     If hndMetaFile = 0 Then
  608.         MsgBox "Metafile must be defined before saving"
  609.         Exit Sub
  610.     End If
  611.     CMDialogMF.DialogTitle = "Save a metafile"
  612.     CMDialogMF.Action = 2
  613.     usefile$ = CMDialogMF.FileName
  614.     If usefile$ <> "" Then
  615.         di = SaveTheMetafile(usefile$, hndMetaFile, CInt(Picture1.ScaleWidth), CInt(Picture1.ScaleHeight))
  616.     End If
  617. End Sub
  618. '   Mouse clicks in Picture1
  619. Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  620.     Dim pt%, px%, py%
  621.     ' If last command was an execute, clear the points to
  622.     ' start a new image
  623.     If LastWasExecute% Then
  624.         PointsUsed% = 0
  625.         LastWasExecute% = 0
  626.         End If
  627.     ' If the maximum number of points has been exceeded
  628.     ' Shift all of the points down
  629.     If PointsUsed% >= MaxPoints% Then
  630.         For pt% = 1 To MaxPoints%
  631.             PointArray(pt% - 1) = PointArray(pt%)
  632.             Next pt%
  633.         PointsUsed% = PointsUsed% - 1
  634.         End If
  635.     ' Add the current point to the list
  636.     PointArray(PointsUsed%).x = CInt(x)
  637.     PointArray(PointsUsed%).y = CInt(y)
  638.     PointsUsed% = PointsUsed% + 1
  639.     Picture1.Cls
  640.     ' Draw small + indicators to show where the points are.
  641.     For pt% = 0 To PointsUsed% - 1
  642.         px% = PointArray(pt%).x
  643.         py% = PointArray(pt%).y
  644.         Picture1.Line (px% - 2, py%)-(px% + 3, py%)
  645.         Picture1.Line (px%, py% - 2)-(px%, py% + 3)
  646.     Next pt%
  647. End Sub
  648. '   This picture control shows a rectangle drawn in the
  649. '   current pen and brush.
  650. Private Sub Picture3_Paint()
  651.     Dim rc As RECT
  652.     #If Win32 Then
  653.         Dim hwnd&
  654.         Dim oldpen&, oldbrush&
  655.         Dim di&
  656.     #Else
  657.         Dim hwnd%
  658.         Dim oldpen%, oldbrush%
  659.         Dim di%
  660.     #End If
  661.     ' Get the window handle for Picture2
  662.     hwnd = Picture3.hwnd
  663.     ' Get a rectangle with the client area size...
  664.     GetClientRect hwnd, rc
  665.     '.. and shrink it by 10 pixels on a side.
  666.     InflateRect rc, -10, -10
  667.     ' Select in our private pen and brush
  668.     If hndPen <> 0 And hndBrush <> 0 Then
  669.         oldpen = SelectObject(Picture3.hDC, hndPen)
  670.         oldbrush = SelectObject(Picture3.hDC, hndBrush)
  671.         End If
  672.     ' Draw the rectangle
  673.     di = Rectangle(Picture3.hDC, rc.Left, rc.Top, rc.Right, rc.Bottom)
  674.     ' Be sure to restore the original GDI objects!
  675.     If oldpen <> 0 Then di = SelectObject(Picture3.hDC, oldpen)
  676.     If oldbrush <> 0 Then di = SelectObject(Picture3.hDC, oldbrush)
  677. End Sub
  678. '   These scroll bars are used to select colors, styles and
  679. '   pen widths.  The Min and Max properties are selected
  680. '   such that the Scrollbar value parameter may be used
  681. '   directly in the GDI object creation function.
  682. Private Sub ScrollObject_Change(Index As Integer)
  683.     Dim di%
  684.     ' Wrap around when increasing
  685.     If ScrollObject(Index).value = ScrollObject(Index).Max Then
  686.         ScrollObject(Index).value = ScrollObject(Index).Min + 1
  687.         Exit Sub
  688.         End If
  689.     ' Wrap around when decrementing
  690.     If ScrollObject(Index).value = ScrollObject(Index).Min Then
  691.         ScrollObject(Index).value = ScrollObject(Index).Max - 1
  692.         Exit Sub
  693.         End If
  694.     ' Delete the current objects
  695.     If hndPen Then di = DeleteObject(hndPen)
  696.     If hndBrush Then di = DeleteObject(hndBrush)
  697.     ' Now create the new pen
  698.     hndPen = CreatePen(ScrollObject(2).value, ScrollObject(4).value, QBColor(ScrollObject(0).value))
  699.     ' Now create the new brush
  700.     ' Value 6 indicates that we should create a solid brush
  701.     ' 0-5 indicate styles of hatched brushes.
  702.     If ScrollObject(3).value = 6 Then
  703.         hndBrush = CreateSolidBrush(QBColor(ScrollObject(1).value))
  704.     Else
  705.         hndBrush = CreateHatchBrush(ScrollObject(3).value, QBColor(ScrollObject(1).value))
  706.     End If
  707.     ' Draw a sample rectangle using the current pen&Brush
  708.     ' This forces the Paint event to be triggered.
  709.     Picture3.Refresh
  710. End Sub
  711.