home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Extrude.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-06-24  |  4.7 KB  |  159 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Extrusion3d"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private NumCurvePts As Integer
  17. Private NumPathPts As Integer
  18.  
  19. Private CurvePoints() As Point3D
  20. Private PathPoints() As Point3D
  21.  
  22. Private ThePolyline As Polyline3d
  23. ' Add a point to the generating path.
  24. Public Sub AddPathPoint(ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
  25.     NumPathPts = NumPathPts + 1
  26.     ReDim Preserve PathPoints(1 To NumPathPts)
  27.  
  28.     With PathPoints(NumPathPts)
  29.         .coord(1) = X
  30.         .coord(2) = Y
  31.         .coord(3) = Z
  32.         .coord(4) = 1
  33.     End With
  34. End Sub
  35.  
  36. ' Add a point to the base curve.
  37. Public Sub AddCurvePoint(ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
  38.     NumCurvePts = NumCurvePts + 1
  39.     ReDim Preserve CurvePoints(1 To NumCurvePts)
  40.  
  41.     With CurvePoints(NumCurvePts)
  42.         .coord(1) = X
  43.         .coord(2) = Y
  44.         .coord(3) = Z
  45.         .coord(4) = 1
  46.     End With
  47. End Sub
  48.  
  49. ' Create the display polylines.
  50. Public Sub Extrude()
  51. Dim i As Integer
  52. Dim j As Integer
  53. Dim xoff1 As Single
  54. Dim yoff1 As Single
  55. Dim zoff1 As Single
  56. Dim xoff2 As Single
  57. Dim yoff2 As Single
  58. Dim zoff2 As Single
  59. Dim x1 As Single
  60. Dim y1 As Single
  61. Dim z1 As Single
  62. Dim x2 As Single
  63. Dim y2 As Single
  64. Dim z2 As Single
  65.  
  66.     Set ThePolyline = New Polyline3d
  67.  
  68.     ' Create the translated images of the curve.
  69.     For i = 1 To NumPathPts
  70.         ' Calculate offsets for this path point.
  71.         xoff1 = PathPoints(i).coord(1) - PathPoints(1).coord(1)
  72.         yoff1 = PathPoints(i).coord(2) - PathPoints(1).coord(2)
  73.         zoff1 = PathPoints(i).coord(3) - PathPoints(1).coord(3)
  74.  
  75.         x1 = CurvePoints(1).coord(1) + xoff1
  76.         y1 = CurvePoints(1).coord(2) + yoff1
  77.         z1 = CurvePoints(1).coord(3) + zoff1
  78.         For j = 2 To NumCurvePts
  79.             x2 = CurvePoints(j).coord(1) + xoff1
  80.             y2 = CurvePoints(j).coord(2) + yoff1
  81.             z2 = CurvePoints(j).coord(3) + zoff1
  82.             ThePolyline.AddSegment x1, y1, z1, x2, y2, z2
  83.             x1 = x2
  84.             y1 = y2
  85.             z1 = z2
  86.         Next j
  87.     Next i
  88.  
  89.     ' Create the translated images of the path.
  90.     xoff1 = PathPoints(1).coord(1) - PathPoints(1).coord(1)
  91.     yoff1 = PathPoints(1).coord(2) - PathPoints(1).coord(2)
  92.     zoff1 = PathPoints(1).coord(3) - PathPoints(1).coord(3)
  93.     For i = 2 To NumPathPts
  94.         ' Calculate offsets for this path point.
  95.         xoff2 = PathPoints(i).coord(1) - PathPoints(1).coord(1)
  96.         yoff2 = PathPoints(i).coord(2) - PathPoints(1).coord(2)
  97.         zoff2 = PathPoints(i).coord(3) - PathPoints(1).coord(3)
  98.  
  99.         For j = 1 To NumCurvePts
  100.             ThePolyline.AddSegment _
  101.                 CurvePoints(j).coord(1) + xoff1, _
  102.                 CurvePoints(j).coord(2) + yoff1, _
  103.                 CurvePoints(j).coord(3) + zoff1, _
  104.                 CurvePoints(j).coord(1) + xoff2, _
  105.                 CurvePoints(j).coord(2) + yoff2, _
  106.                 CurvePoints(j).coord(3) + zoff2
  107.         Next j
  108.         xoff1 = xoff2
  109.         yoff1 = yoff2
  110.         zoff1 = zoff2
  111.     Next i
  112. End Sub
  113.  
  114. ' Apply a transformation matrix which may not
  115. ' contain 0, 0, 0, 1 in the last column to the
  116. ' object.
  117. Public Sub ApplyFull(M() As Single)
  118. Dim i As Integer
  119.  
  120.     ' Transform the base curve.
  121.     For i = 1 To NumCurvePts
  122.         m3ApplyFull CurvePoints(i).coord, M, _
  123.                     CurvePoints(i).trans
  124.     Next i
  125.  
  126.     ' Transform the generating path.
  127.     For i = 1 To NumPathPts
  128.         m3ApplyFull PathPoints(i).coord, M, _
  129.                     PathPoints(i).trans
  130.     Next i
  131.  
  132.     ' Transform the display polyline if it exists.
  133.     If Not (ThePolyline Is Nothing) Then ThePolyline.ApplyFull M
  134. End Sub
  135. ' Apply a transformation matrix to the object.
  136. Public Sub Apply(M() As Single)
  137. Dim i As Integer
  138.  
  139.     ' Transform the base curve.
  140.     For i = 1 To NumCurvePts
  141.         m3Apply CurvePoints(i).coord, M, _
  142.                 CurvePoints(i).trans
  143.     Next i
  144.  
  145.     ' Transform the generating path.
  146.     For i = 1 To NumPathPts
  147.         m3Apply PathPoints(i).coord, M, _
  148.                 PathPoints(i).trans
  149.     Next i
  150.  
  151.     ' Transform the display polyline if it exists.
  152.     If Not (ThePolyline Is Nothing) Then ThePolyline.Apply M
  153. End Sub
  154. ' Draw the extrusion on a PictureBox.
  155. Public Sub Draw(ByVal pic As PictureBox, Optional R As Variant)
  156.     If Not ThePolyline Is Nothing Then _
  157.         ThePolyline.Draw pic, R
  158. End Sub
  159.