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 / classlib / desaware / samplev5 / rectapi / rectplay.frm (.txt) < prev   
Encoding:
Visual Basic Form  |  1997-02-17  |  9.5 KB  |  252 lines
  1. VERSION 5.00
  2. Begin VB.Form RectPlay 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    Caption         =   "RectPlay"
  6.    ClientHeight    =   3990
  7.    ClientLeft      =   1095
  8.    ClientTop       =   1770
  9.    ClientWidth     =   4950
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    LinkMode        =   1  'Source
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   3990
  24.    ScaleWidth      =   4950
  25.    Begin VB.PictureBox Picture1 
  26.       Appearance      =   0  'Flat
  27.       BackColor       =   &H80000005&
  28.       ForeColor       =   &H00000000&
  29.       Height          =   3255
  30.       Left            =   180
  31.       ScaleHeight     =   215
  32.       ScaleMode       =   3  'Pixel
  33.       ScaleWidth      =   311
  34.       TabIndex        =   0
  35.       Top             =   540
  36.       Width           =   4695
  37.    End
  38.    Begin VB.Label Label1 
  39.       Appearance      =   0  'Flat
  40.       BackColor       =   &H80000005&
  41.       Caption         =   "Label1"
  42.       ForeColor       =   &H80000008&
  43.       Height          =   255
  44.       Left            =   120
  45.       TabIndex        =   1
  46.       Top             =   120
  47.       Width           =   3735
  48.    End
  49.    Begin VB.Menu MenuViewBar 
  50.       Caption         =   "View"
  51.       Begin VB.Menu MenuView 
  52.          Caption         =   "Rect&1"
  53.          Checked         =   -1  'True
  54.          Index           =   0
  55.       End
  56.       Begin VB.Menu MenuView 
  57.          Caption         =   "Rect&2"
  58.          Checked         =   -1  'True
  59.          Index           =   1
  60.       End
  61.       Begin VB.Menu MenuView 
  62.          Caption         =   "&Union"
  63.          Index           =   2
  64.       End
  65.       Begin VB.Menu MenuView 
  66.          Caption         =   "&Intersect"
  67.          Index           =   3
  68.       End
  69.       Begin VB.Menu MenuView 
  70.          Caption         =   "&Offset"
  71.          Index           =   4
  72.       End
  73.       Begin VB.Menu MenuView 
  74.          Caption         =   "&Subtract"
  75.          Index           =   5
  76.       End
  77.    End
  78.    Begin VB.Menu ModeViewBar 
  79.       Caption         =   "Mode"
  80.       Begin VB.Menu MenuMode 
  81.          Caption         =   "Point"
  82.          Index           =   0
  83.       End
  84.       Begin VB.Menu MenuMode 
  85.          Caption         =   "SetRect1"
  86.          Index           =   1
  87.       End
  88.       Begin VB.Menu MenuMode 
  89.          Caption         =   "SetRect2"
  90.          Index           =   2
  91.       End
  92.    End
  93. Attribute VB_Name = "RectPlay"
  94. Attribute VB_GlobalNameSpace = False
  95. Attribute VB_Creatable = False
  96. Attribute VB_PredeclaredId = True
  97. Attribute VB_Exposed = False
  98. ' One of the first changes from the original code
  99. ' was to add Option Explicit here.  The original
  100. ' program goes back to VB 1.0!
  101. Option Explicit
  102. '   Displays information about the point in the EndPoint
  103. '   global variable (which is set during the Picture1
  104. '   MouseUp event.
  105. Private Sub DoPointDisplay()
  106.     Dim outstring$, crlf$
  107.     Dim tlong&
  108.     ' Unfortunately, the order in which elements are
  109.     ' placed on the stack differs for Win16 and Win32,
  110.     ' So we have to do a swap as follows
  111.     ' Define a newline string
  112.     crlf$ = Chr$(13) + Chr$(10)
  113.     ' Here we changed the PtInRect to accept the two
  114.     ' POINTAPI fields individually instead of converting it first
  115.     ' into a long as was done in the original 16 bit example.
  116.     If Rect1.PtInRect(EndPoint) Then
  117.         outstring$ = "is in Rect1" + crlf$
  118.     End If
  119.     If Rect2.PtInRect(EndPoint) Then
  120.        outstring$ = outstring$ + "is in Rect2" + crlf$
  121.     End If
  122.     If RectUnion.PtInRect(EndPoint) Then
  123.         outstring$ = outstring$ + "is in RectUnion" + crlf$
  124.     End If
  125.     If RectIntersect.PtInRect(EndPoint) Then
  126.         outstring$ = outstring$ + "is in RectIntersect" + crlf$
  127.     End If
  128.     If RectSubtract.PtInRect(EndPoint) Then
  129.         outstring$ = outstring$ + "is in RectSubtract" + crlf$
  130.     End If
  131.     'If RectOffset.PtInRect(EndPoint) Then
  132.     '    outstring$ = outstring$ + "is in RectOffset" + crlf$
  133.     'End If
  134.     If outstring$ = "" Then outstring$ = "is not in any rectangle"
  135.     MsgBox outstring$, 0, "Selected Point"
  136. End Sub
  137. Private Sub Form_Load()
  138.     SettingState% = 1   ' Set the initial value
  139. End Sub
  140. '   Set the Label1 control based on the SettingState%
  141. '   global variable to indicate to the user what the
  142. '   operating mode is.
  143. Private Sub Form_Paint()
  144.     Select Case SettingState%
  145.         Case 0
  146.             Label1.Caption = "Point Detect"
  147.         Case 1
  148.             Label1.Caption = "Set Rect 1"
  149.         Case 2
  150.             Label1.Caption = "Set Rect 2"
  151.     End Select
  152. End Sub
  153. '   Set the SettingState% variable according to the
  154. '   mode command selected.
  155. Private Sub MenuMode_Click(Index As Integer)
  156.     SettingState% = Index
  157.     RectPlay.Refresh
  158. End Sub
  159. '   Check or uncheck the item to view
  160. '   Then redraw the picture box
  161. Private Sub MenuView_Click(Index As Integer)
  162.     If MenuView(Index).Checked Then
  163.         MenuView(Index).Checked = 0
  164.     Else: MenuView(Index).Checked = -1
  165.     End If
  166.     Picture1.Refresh
  167. End Sub
  168. '   Record the current mouse location in StartPoint, and
  169. '   set the drawing mode to exclusive or
  170. Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  171.     ' This conversion is safe, as we are in pixels
  172.     ' Note: The original RectPlay program used explicit type
  173.     ' conversions such as "StartPoint.X = CInt(X)"
  174.     ' Because the point fields can be integers or longs depending
  175.     ' on platform, it's better to just let VB do its automatic
  176.     ' conversion than to coerce it to the wrong one or use conditional compilation.
  177.     StartPoint.SetPoint x, y
  178.     EndPoint.SetPoint x, y
  179.     ' Drawing will be exclusive Or
  180.     Picture1.DrawMode = vbNotXorPen
  181.     HasCapture% = -1
  182. End Sub
  183. '   If mouse tracking is in effect, and a rectangle
  184. '   is being drawn, erase the prior rectangle and draw
  185. '   one based on the new location.
  186. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  187.     If SettingState% <> 0 And HasCapture% Then
  188.         Picture1.Line (StartPoint.x, StartPoint.y)-(EndPoint.x, EndPoint.y), , B
  189.         Picture1.Line (StartPoint.x, StartPoint.y)-(x, y), , B
  190.     End If
  191.     EndPoint.SetPoint x, y
  192. End Sub
  193. '   Erase the prior rectangle and save the information
  194. '   in the appropriate global rectangle.
  195. Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  196.     ' If we're not mouse tracking, exit the subroutine
  197.     If Not HasCapture% Then Exit Sub
  198.     If SettingState% <> 0 Then
  199.         Picture1.Line (StartPoint.x, StartPoint.y)-(EndPoint.x, EndPoint.y), , B
  200.     End If
  201.     EndPoint.SetPoint x, y
  202.     Select Case SettingState%
  203.         Case 0
  204.             DoPointDisplay  ' Show point information
  205.         Case 1
  206.             Rect1.SetRect StartPoint.x, StartPoint.y, EndPoint.x, EndPoint.y
  207.         Case 2
  208.             Rect2.SetRect StartPoint.x, StartPoint.y, EndPoint.x, EndPoint.y
  209.     End Select
  210.     HasCapture% = 0
  211.     ' Restore the original drawing mode
  212.     Picture1.DrawMode = vbCopyPen
  213.     Picture1.Refresh
  214. End Sub
  215. '   Draw each of the rectangles that are requested,
  216. '   each in a different color.
  217. Private Sub Picture1_Paint()
  218.     ' Find the union and intersection rectangles
  219.     ' Using API calls
  220.     Debug.Print "Offset Point" & EndPoint.x, EndPoint.y
  221.     Debug.Print "rect1 " & Rect1.left, Rect1.Top, Rect1.right, Rect1.bottom
  222.     Debug.Print "rect2 " & Rect2.left, Rect2.Top, Rect2.right, Rect2.bottom
  223.     Call RectIntersect.IntersectRect(Rect1, Rect2)
  224.     Call RectUnion.UnionRect(Rect1, Rect2)
  225.     'Debug.Print "Offset 2a " & RectOffset.left, RectOffset.top, RectOffset.right, RectOffset.bottom
  226.     'RectOffset.OffsetRect 20, 20
  227.     'Debug.Print "Offset 2afb " & RectOffset.left, RectOffset.top, RectOffset.right, RectOffset.bottom
  228.     Call RectSubtract.SubtractRect(Rect1, Rect2)
  229.     Debug.Print " Subtract " & RectSubtract.left, RectSubtract.Top, RectSubtract.right, RectSubtract.bottom
  230.     If MenuView(0).Checked Then ' Rect1
  231.         Picture1.Line (Rect1.left, Rect1.Top)-(Rect1.right, Rect1.bottom), QBColor(1), B
  232.     End If
  233.     If MenuView(1).Checked Then ' Rect2
  234.         Picture1.Line (Rect2.left, Rect2.Top)-(Rect2.right, Rect2.bottom), QBColor(2), B
  235.     End If
  236.     If MenuView(2).Checked Then ' Union
  237.         Picture1.Line (RectUnion.left, RectUnion.Top)-(RectUnion.right, RectUnion.bottom), QBColor(8), B
  238.     End If
  239.     If MenuView(3).Checked Then
  240.         Picture1.Line (RectIntersect.left, RectIntersect.Top)-(RectIntersect.right, RectIntersect.bottom), QBColor(4), B
  241.     End If
  242.     If MenuView(4).Checked Then
  243.       '  Picture1.Line (Rect1.left, Rect1.top)-(Rect1.right, Rect1.bottom), QBColor(11), B
  244.       '  Picture1.Line (RectOffset.left, RectOffset.top)-(RectOffset.right, RectOffset.bottom), QBColor(14), B
  245.       '  Picture1.Line (Rect1.left, Rect1.top)-(RectOffset.bottom, RectOffset.right), QBColor(4), B
  246.     End If
  247.     If MenuView(5).Checked Then
  248.         Picture1.Line (RectSubtract.left, RectSubtract.Top)-(RectSubtract.right, RectSubtract.bottom), QBColor(14), B
  249.     End If
  250.          RectOffset.SetRectEmpty
  251. End Sub
  252.