home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH14 / SRC / OBJPICT.CLS < prev    next >
Encoding:
Text File  |  1996-05-04  |  3.5 KB  |  142 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. Const TYPE_STRING = "4D APF PICTURE"
  13.  
  14.  
  15. ' ***********************************************
  16. ' Fix the data coordinates at their transformed
  17. ' values.
  18. ' ***********************************************
  19. Public Sub FixPoints()
  20. Dim obj As Object
  21.  
  22.     For Each obj In objects
  23.         obj.FixPoints
  24.     Next obj
  25. End Sub
  26.  
  27.  
  28. ' ************************************************
  29. ' Find an object that contains this point.
  30. ' ************************************************
  31. Function NearestObject(x As Single, y As Single) As Object
  32. Dim obj As Object
  33.        
  34.     ' Find the object.
  35.     For Each obj In objects
  36.         If obj.Contains(x, y) Then
  37.             Set NearestObject = obj
  38.             Exit Function
  39.         End If
  40.     Next obj
  41.     Set NearestObject = Nothing
  42. End Function
  43.  
  44.  
  45. Function ObjectType() As String
  46.     ObjectType = TYPE_STRING
  47. End Function
  48.  
  49.  
  50.  
  51. ' ************************************************
  52. ' Read the picture from a file using Input.
  53. ' Assume TYPE_STRING has already been read.
  54. ' ************************************************
  55. Sub FileInput(filenum As Integer)
  56. Dim num As Integer
  57. Dim i As Integer
  58. Dim obj As Object
  59. Dim obj_type As String
  60.  
  61.     ' Read the number of objects in the file.
  62.     Input #filenum, num
  63.     
  64.     ' Repeatedly read objects from the file.
  65.     For i = 1 To num
  66.         Input #filenum, obj_type
  67.         Select Case obj_type
  68.             Case TYPE_STRING
  69.                 Set obj = New ObjPicture
  70.             Case Else
  71.                 Beep
  72.                 MsgBox "Unknown object type """ & obj_type & """.", , vbExclamation
  73.                 Exit Sub
  74.         End Select
  75.         obj.FileInput filenum
  76.         objects.Add obj
  77.     Next i
  78. End Sub
  79.  
  80. ' ************************************************
  81. ' Draw the picture on a Form, Printer, or
  82. ' PictureBox.
  83. ' ************************************************
  84. Sub Draw(canvas As Object, Optional r As Variant)
  85. Dim obj As Object
  86.  
  87.     For Each obj In objects
  88.         obj.Draw canvas, r
  89.     Next obj
  90. End Sub
  91.  
  92. ' ************************************************
  93. ' Write the picture to a file using Write.
  94. ' Begin with TYPE_STRING to identify this object.
  95. ' ************************************************
  96. Sub FileWrite(filenum As Integer)
  97. Dim obj As Object
  98.  
  99.     Write #filenum, TYPE_STRING
  100.     Write #filenum, objects.Count
  101.     
  102.     For Each obj In objects
  103.         obj.FileWrite filenum
  104.     Next obj
  105. End Sub
  106.  
  107. ' ************************************************
  108. ' Apply a nonlinear transformation to the objects.
  109. ' ************************************************
  110. Sub Distort(trans As Object)
  111. Dim obj As Object
  112.  
  113.     For Each obj In objects
  114.         obj.Distort trans
  115.     Next obj
  116. End Sub
  117.  
  118.  
  119. ' ************************************************
  120. ' Apply a transformation matrix which may not
  121. ' contain 0, 0, 0, 1 in the last column to the
  122. ' objects.
  123. ' ************************************************
  124. Sub ApplyFull(M() As Single)
  125. Dim obj As Object
  126.  
  127.     For Each obj In objects
  128.         obj.ApplyFull M
  129.     Next obj
  130. End Sub
  131. ' ************************************************
  132. ' Apply a transformation matrix to the objects.
  133. ' ************************************************
  134. Sub Apply(M() As Single)
  135. Dim obj As Object
  136.  
  137.     For Each obj In objects
  138.         obj.Apply M
  139.     Next obj
  140. End Sub
  141.  
  142.