home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH7 / SRC / OBJ3PICT.CLS < prev    next >
Encoding:
Text File  |  1996-05-04  |  3.7 KB  |  147 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjPicture"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Public Objects As New Collection
  11. ' ************************************************
  12. ' Find an object that contains this point.
  13. ' ************************************************
  14. Function NearestObject(x As Single, y As Single) As Object
  15. Dim obj As Object
  16.        
  17.     ' Find the object.
  18.     For Each obj In Objects
  19.         If obj.Contains(x, y) Then
  20.             Set NearestObject = obj
  21.             Exit Function
  22.         End If
  23.     Next obj
  24.     Set NearestObject = Nothing
  25. End Function
  26.  
  27.  
  28. Function ObjectType() As String
  29.     ObjectType = "APF PICTURE"
  30. End Function
  31.  
  32.  
  33. ' ************************************************
  34. ' Compute the world coordinate bounds for the
  35. ' picture.
  36. ' ************************************************
  37. Sub Bound(xmin As Single, ymin As Single, xmax As Single, ymax As Single)
  38. Dim x1 As Single
  39. Dim y1 As Single
  40. Dim x2 As Single
  41. Dim y2 As Single
  42. Dim obj As Object
  43. Dim i As Integer
  44.  
  45.     If Objects.Count < 1 Then
  46.         xmin = 0
  47.         xmax = 1
  48.         ymin = 0
  49.         ymax = 1
  50.         Exit Sub
  51.     End If
  52.     
  53.     Set obj = Objects.Item(1)
  54.     obj.Bound xmin, ymin, xmax, ymax
  55.     
  56.     For i = 2 To Objects.Count
  57.         Set obj = Objects.Item(i)
  58.         obj.Bound x1, y1, x2, y2
  59.         If x1 < xmin Then xmin = x1
  60.         If y1 < ymin Then ymin = y1
  61.         If x2 > xmax Then xmax = x2
  62.         If y2 > ymax Then ymax = y2
  63.     Next i
  64. End Sub
  65. ' ************************************************
  66. ' Read the picture from a file using Input.
  67. ' Begin with "PICTURE" to identify this object.
  68. ' ************************************************
  69. Sub FileInput(filenum As Integer)
  70. Dim num As Integer
  71. Dim i As Integer
  72. Dim obj As Object
  73. Dim obj_type As String
  74.  
  75.     ' Read the number of objects in the file.
  76.     Input #filenum, num
  77.     
  78.     ' Repeatedly read objects from the file.
  79.     For i = 1 To num
  80.         Input #filenum, obj_type
  81.         Select Case obj_type
  82.             Case "APF PICTURE"
  83.                 Set obj = New ObjPicture
  84.             Case "POLYGON"
  85.                 Set obj = New ObjPolygon
  86.             Case Else
  87.                 Beep
  88.                 MsgBox "Unknown object type """ & obj_type & """.", , vbExclamation
  89.                 Exit Sub
  90.         End Select
  91.         obj.FileInput filenum
  92.         Objects.Add obj
  93.     Next i
  94. End Sub
  95.  
  96. ' ************************************************
  97. ' Draw the picture on a Form, Printer, or
  98. ' PictureBox.
  99. ' ************************************************
  100. Sub Draw(canvas As Object)
  101. Dim obj As Object
  102.  
  103.     For Each obj In Objects
  104.         obj.Draw canvas
  105.     Next obj
  106. End Sub
  107. ' ************************************************
  108. ' Write the picture to a file using Write.
  109. ' Begin with "APF PICTURE" to identify this object.
  110. ' ************************************************
  111. Sub FileWrite(filenum As Integer)
  112. Dim obj As Object
  113.  
  114.     Write #filenum, "APF PICTURE"
  115.     Write #filenum, Objects.Count
  116.     
  117.     For Each obj In Objects
  118.         obj.FileWrite filenum
  119.     Next obj
  120. End Sub
  121.  
  122. ' ************************************************
  123. ' Apply a nonlinear transformation to the objects.
  124. ' ************************************************
  125. Sub Distort(trans As Object)
  126. Dim obj As Object
  127.  
  128.     For Each obj In Objects
  129.         obj.Distort trans
  130.     Next obj
  131. End Sub
  132.  
  133.  
  134. ' ************************************************
  135. ' Apply a transformation matrix to the objects.
  136. ' ************************************************
  137. Sub Transform(M() As Single)
  138. Dim obj As Object
  139.  
  140.     For Each obj In Objects
  141.         obj.Transform M
  142.     Next obj
  143. End Sub
  144.  
  145.  
  146.  
  147.