home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH10 / SRC / OBJPICT.CLS < prev    next >
Encoding:
Text File  |  1996-05-02  |  4.4 KB  |  173 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 = "3D APF PICTURE"
  13.  
  14.  
  15. ' ************************************************
  16. ' Find an object that contains this point.
  17. ' ************************************************
  18. Function NearestObject(x As Single, y As Single) As Object
  19. Dim obj As Object
  20.        
  21.     ' Find the object.
  22.     For Each obj In objects
  23.         If obj.Contains(x, y) Then
  24.             Set NearestObject = obj
  25.             Exit Function
  26.         End If
  27.     Next obj
  28.     Set NearestObject = Nothing
  29. End Function
  30.  
  31.  
  32. Function ObjectType() As String
  33.     ObjectType = TYPE_STRING
  34. End Function
  35.  
  36. ' ************************************************
  37. ' Save the picture to a new metafile.
  38. ' ************************************************
  39. Sub SaveWMF(name As String)
  40. Dim mhdc As Integer
  41. Dim hMF As Integer
  42. Dim status As Long
  43.  
  44.     ' Create the metafile.
  45.     mhdc = CreateMetaFile(ByVal name)
  46.     If mhdc = 0 Then
  47.         Beep
  48.         MsgBox "Error creating metafile """" & name & """"."
  49.         Exit Sub
  50.     End If
  51.  
  52.     MakeWMF mhdc
  53.     
  54.     hMF = CloseMetaFile(mhdc)
  55.     status = DeleteMetaFile(hMF)
  56. End Sub
  57.  
  58.  
  59. ' ************************************************
  60. ' Save the objects in the picture into a metafile.
  61. ' ************************************************
  62. Sub MakeWMF(mhdc As Integer)
  63. Dim obj As Object
  64.  
  65.     For Each obj In objects
  66.         obj.MakeWMF mhdc
  67.     Next obj
  68. End Sub
  69.  
  70.  
  71.  
  72. ' ************************************************
  73. ' Read the picture from a file using Input.
  74. ' Assume TYPE_STRING has already been read.
  75. ' ************************************************
  76. Sub FileInput(filenum As Integer)
  77. Dim num As Integer
  78. Dim i As Integer
  79. Dim obj As Object
  80. Dim obj_type As String
  81.  
  82.     ' Read the number of objects in the file.
  83.     Input #filenum, num
  84.     
  85.     ' Repeatedly read objects from the file.
  86.     For i = 1 To num
  87.         Input #filenum, obj_type
  88.         Select Case obj_type
  89.             Case TYPE_STRING
  90.                 Set obj = New ObjPicture
  91.             Case "POLYLINE"
  92.                 Set obj = New ObjPolyline
  93.             Case "GRID"
  94.                 Set obj = New ObjGrid3D
  95.             Case "SPARSE_GRID"
  96.                 Set obj = New ObjSparseGrid
  97.             Case "BEZIER"
  98.                 Set obj = New ObjBezier
  99.             Case "BSPLINE"
  100.                 Set obj = New ObjBSpline
  101.             Case Else
  102.                 Beep
  103.                 MsgBox "Unknown object type """ & obj_type & """.", , vbExclamation
  104.                 Exit Sub
  105.         End Select
  106.         obj.FileInput filenum
  107.         objects.Add obj
  108.     Next i
  109. End Sub
  110.  
  111. ' ************************************************
  112. ' Draw the picture on a Form, Printer, or
  113. ' PictureBox.
  114. ' ************************************************
  115. Sub Draw(canvas As Object, Optional r As Variant)
  116. Dim obj As Object
  117.  
  118.     For Each obj In objects
  119.         obj.Draw canvas, r
  120.     Next obj
  121. End Sub
  122.  
  123. ' ************************************************
  124. ' Write the picture to a file using Write.
  125. ' Begin with TYPE_STRING to identify this object.
  126. ' ************************************************
  127. Sub FileWrite(filenum As Integer)
  128. Dim obj As Object
  129.  
  130.     Write #filenum, TYPE_STRING
  131.     Write #filenum, objects.Count
  132.     
  133.     For Each obj In objects
  134.         obj.FileWrite filenum
  135.     Next obj
  136. End Sub
  137.  
  138. ' ************************************************
  139. ' Apply a nonlinear transformation to the objects.
  140. ' ************************************************
  141. Sub Distort(trans As Object)
  142. Dim obj As Object
  143.  
  144.     For Each obj In objects
  145.         obj.Distort trans
  146.     Next obj
  147. End Sub
  148.  
  149.  
  150. ' ************************************************
  151. ' Apply a transformation matrix which may not
  152. ' contain 0, 0, 0, 1 in the last column to the
  153. ' objects.
  154. ' ************************************************
  155. Sub ApplyFull(M() As Single)
  156. Dim obj As Object
  157.  
  158.     For Each obj In objects
  159.         obj.ApplyFull M
  160.     Next obj
  161. End Sub
  162. ' ************************************************
  163. ' Apply a transformation matrix to the objects.
  164. ' ************************************************
  165. Sub Apply(M() As Single)
  166. Dim obj As Object
  167.  
  168.     For Each obj In objects
  169.         obj.Apply M
  170.     Next obj
  171. End Sub
  172.  
  173.