home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH7 / SRC / OBJ2POLY.CLS < prev    next >
Encoding:
Text File  |  1996-05-04  |  3.5 KB  |  137 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjPolygon"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Private num_points As Integer
  11. Private y() As Single
  12. Private x() As Single
  13.  
  14. Function ObjectType() As String
  15.     ObjectType = "POLYGON"
  16. End Function
  17.  
  18. ' ************************************************
  19. ' Set the coordinates for a point.
  20. ' ************************************************
  21. Sub SetPoint(Index As Integer, x1 As Single, y1 As Single)
  22.     If Index < 1 Or Index > num_points Then Exit Sub
  23.     x(Index) = x1
  24.     y(Index) = y1
  25. End Sub
  26.  
  27. ' ************************************************
  28. ' Apply a transformation matrix to the object.
  29. ' ************************************************
  30. Sub Transform(M() As Single)
  31. Dim i As Integer
  32.  
  33.     For i = 1 To num_points
  34.         m2PointMultiply x(i), y(i), M
  35.     Next i
  36. End Sub
  37.  
  38. ' ************************************************
  39. ' Apply a nonlinear transformation.
  40. ' ************************************************
  41. Sub Distort(d As Object)
  42. Dim i As Integer
  43.  
  44.     For i = 1 To num_points
  45.         d.Distort x(i), y(i)
  46.     Next i
  47. End Sub
  48. ' ************************************************
  49. ' Set the number of points and redimension the
  50. ' point arrays.
  51. ' ************************************************
  52. Property Let NumPoints(n As Integer)
  53.     If n < 1 Then
  54.         Erase x
  55.         Erase y
  56.         num_points = 0
  57.         Exit Property
  58.     End If
  59.     
  60.     num_points = n
  61.     ReDim x(1 To num_points)
  62.     ReDim y(1 To num_points)
  63. End Property
  64. ' ************************************************
  65. ' Compute the world coordinate bounds for the
  66. ' polygon.
  67. ' ************************************************
  68. Sub Bound(xmin As Single, ymin As Single, xmax As Single, ymax As Single)
  69. Dim i As Integer
  70.  
  71.     If num_points = 0 Then
  72.         xmin = 0
  73.         xmax = 0
  74.         ymin = 0
  75.         ymax = 0
  76.         Exit Sub
  77.     End If
  78.     
  79.     xmin = x(1)
  80.     xmax = x(1)
  81.     ymin = y(1)
  82.     ymax = y(1)
  83.     For i = 2 To num_points
  84.         If x(i) < xmin Then xmin = x(i)
  85.         If y(i) < ymin Then ymin = y(i)
  86.         If x(i) > xmax Then xmax = x(i)
  87.         If y(i) > ymax Then ymax = y(i)
  88.     Next i
  89. End Sub
  90.  
  91. ' ************************************************
  92. ' Write a polygon to a file using Write.
  93. ' Begin with "POLYGON" to identify this object.
  94. ' ************************************************
  95. Sub FileWrite(filenum As Integer)
  96. Dim i As Integer
  97.  
  98.     Write #filenum, "POLYGON", num_points
  99.     For i = 1 To num_points
  100.         Write #filenum, x(i), y(i)
  101.     Next i
  102. End Sub
  103. ' ************************************************
  104. ' Draw the polygon on a Form, Printer, or
  105. ' PictureBox.
  106. ' ************************************************
  107. Sub Draw(canvas As Object)
  108. Dim i As Integer
  109.  
  110.     ' Don't draw if there are no points.
  111.     If num_points < 1 Then Exit Sub
  112.        
  113.     canvas.CurrentX = x(1)
  114.     canvas.CurrentY = y(1)
  115.     For i = 2 To num_points
  116.         canvas.Line -(x(i), y(i))
  117.     Next i
  118. End Sub
  119.  
  120. ' ************************************************
  121. ' Read a polygon from a file using Input.
  122. ' Assume the "POLYGON" label has already been read.
  123. ' ************************************************
  124. Sub FileInput(filenum As Integer)
  125. Dim i As Integer
  126.  
  127.     Input #filenum, num_points
  128.     If num_points < 1 Then Exit Sub
  129.     ReDim x(1 To num_points)
  130.     ReDim y(1 To num_points)
  131.     For i = 1 To num_points
  132.         Input #filenum, x(i), y(i)
  133.     Next i
  134. End Sub
  135.  
  136.  
  137.