home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH13 / SRC / OBJFACE.CLS < prev    next >
Encoding:
Text File  |  1996-04-15  |  8.9 KB  |  308 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjFace"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. ' The plane that contains the polygon.
  11. Private plane As New ObjFacePlane
  12.  
  13. Private NumPts As Integer   ' Number of points.
  14. Private Points() As Point3D ' Data points.
  15.  
  16. ' ************************************************
  17. ' Set constants for transmitted light.
  18. ' ************************************************
  19. Sub SetKt(n As Single, N1 As Single, N2 As Single, r As Single, G As Single, B As Single)
  20.     plane.SetKt n, N1, N2, r, G, B
  21. End Sub
  22.  
  23.  
  24.  
  25. ' ************************************************
  26. ' Return the red, green, and blue components of
  27. ' the surface at the hit position.
  28. ' ************************************************
  29. Public Sub HitColor(depth As Integer, Objects As Collection, r As Integer, G As Integer, B As Integer)
  30.     plane.HitColor depth, Objects, r, G, B
  31. End Sub
  32.  
  33. ' ************************************************
  34. ' Return true if the point lies within the
  35. ' polygon.
  36. ' ************************************************
  37. Function PointInside(x As Single, y As Single, z As Single) As Boolean
  38. Dim i As Integer
  39. Dim xok As Boolean
  40. Dim yok As Boolean
  41. Dim zok As Boolean
  42.  
  43.     ' See in which coordinates the points differ.
  44.     ' X coordinates.
  45.     For i = 2 To NumPts
  46.         If Points(i - 1).trans(1) <> Points(i).trans(1) _
  47.             Then Exit For
  48.     Next i
  49.     xok = (i <= NumPts)
  50.     
  51.     ' Y coordinates.
  52.     For i = 2 To NumPts
  53.         If Points(i - 1).trans(2) <> Points(i).trans(2) _
  54.             Then Exit For
  55.     Next i
  56.     yok = (i <= NumPts)
  57.     
  58.     ' Z coordinates.
  59.     For i = 2 To NumPts
  60.         If Points(i - 1).trans(3) <> Points(i).trans(3) _
  61.             Then Exit For
  62.     Next i
  63.     zok = (i <= NumPts)
  64.     
  65.     If xok And yok Then
  66.         PointInside = PointInsideXY(x, y)
  67.     ElseIf yok And zok Then
  68.         PointInside = PointInsideYZ(y, z)
  69.     ElseIf xok And zok Then
  70.         PointInside = PointInsideXZ(x, z)
  71.     Else
  72.         PointInside = False
  73.     End If
  74. End Function
  75.  
  76. ' ************************************************
  77. ' Compute the distance from point (px, py, pz)
  78. ' along vector <vx, vy, vz> to the polygon.
  79. ' ************************************************
  80. Public Function RayDistance(px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single) As Single
  81. Dim dist As Single
  82. Dim x As Single
  83. Dim y As Single
  84. Dim z As Single
  85. Dim dx As Single
  86. Dim dy As Single
  87. Dim dz As Single
  88.  
  89.     ' Find the distance to the plane.
  90.     dist = plane.RayDistance(px, py, pz, Vx, Vy, Vz)
  91.     
  92.     ' If there is no good intersection with the
  93.     ' plane, there's none with the polygon.
  94.     If dist >= INFINITY Then
  95.         RayDistance = INFINITY
  96.         Exit Function
  97.     End If
  98.  
  99.     ' See if the point of intersection lies within
  100.     ' the polygon.
  101.     
  102.     ' Get the hit location.
  103.     plane.HitLocation x, y, z
  104.  
  105.     ' See if the point lies inside the projection
  106.     ' onto the X-Y plane.
  107.     If Not PointInside(x, y, z) Then
  108.         RayDistance = INFINITY
  109.         Exit Function
  110.     End If
  111.     
  112.     RayDistance = dist
  113. End Function
  114.  
  115.  
  116. ' ************************************************
  117. ' Return true if the point projection lies within
  118. ' this polygon's projection onto the Y-Z plane.
  119. ' ************************************************
  120. Function PointInsideYZ(y As Single, z As Single) As Boolean
  121. Dim i As Integer
  122. Dim theta1 As Double
  123. Dim theta2 As Double
  124. Dim dtheta As Double
  125. Dim dy As Double
  126. Dim dz As Double
  127. Dim angles As Double
  128.  
  129.     dy = Points(NumPts).trans(2) - y
  130.     dz = Points(NumPts).trans(3) - z
  131.     theta1 = Arctan2(CSng(dy), CSng(dz))
  132.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  133.     For i = 1 To NumPts
  134.         dy = Points(i).trans(2) - y
  135.         dz = Points(i).trans(3) - z
  136.         theta2 = Arctan2(CSng(dy), CSng(dz))
  137.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  138.         dtheta = theta2 - theta1
  139.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  140.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  141.         angles = angles + dtheta
  142.         theta1 = theta2
  143.     Next i
  144.     
  145.     PointInsideYZ = (Abs(angles) > 0.001)
  146. End Function
  147.  
  148. ' ************************************************
  149. ' Return true if the point projection lies within
  150. ' this polygon's projection onto the X-Z plane.
  151. ' ************************************************
  152. Function PointInsideXZ(x As Single, z As Single) As Boolean
  153. Dim i As Integer
  154. Dim theta1 As Double
  155. Dim theta2 As Double
  156. Dim dtheta As Double
  157. Dim dx As Double
  158. Dim dz As Double
  159. Dim angles As Double
  160.  
  161.     dx = Points(NumPts).trans(1) - x
  162.     dz = Points(NumPts).trans(3) - z
  163.     theta1 = Arctan2(CSng(dx), CSng(dz))
  164.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  165.     For i = 1 To NumPts
  166.         dx = Points(i).trans(1) - x
  167.         dz = Points(i).trans(3) - z
  168.         theta2 = Arctan2(CSng(dx), CSng(dz))
  169.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  170.         dtheta = theta2 - theta1
  171.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  172.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  173.         angles = angles + dtheta
  174.         theta1 = theta2
  175.     Next i
  176.     
  177.     PointInsideXZ = (Abs(angles) > 0.001)
  178. End Function
  179.  
  180. ' ************************************************
  181. ' Return true if the point projection lies within
  182. ' this polygon's projection onto the X-Y plane.
  183. ' ************************************************
  184. Function PointInsideXY(x As Single, y As Single) As Boolean
  185. Dim i As Integer
  186. Dim theta1 As Double
  187. Dim theta2 As Double
  188. Dim dtheta As Double
  189. Dim dx As Double
  190. Dim dy As Double
  191. Dim angles As Double
  192.  
  193.     dx = Points(NumPts).trans(1) - x
  194.     dy = Points(NumPts).trans(2) - y
  195.     theta1 = Arctan2(CSng(dx), CSng(dy))
  196.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  197.     For i = 1 To NumPts
  198.         dx = Points(i).trans(1) - x
  199.         dy = Points(i).trans(2) - y
  200.         theta2 = Arctan2(CSng(dx), CSng(dy))
  201.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  202.         dtheta = theta2 - theta1
  203.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  204.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  205.         angles = angles + dtheta
  206.         theta1 = theta2
  207.     Next i
  208.     
  209.     PointInsideXY = (Abs(angles) > 0.001)
  210. End Function
  211.  
  212. ' ***********************************************
  213. ' Define the plane that contains the polygon.
  214. ' ***********************************************
  215. Public Sub DefinePlane()
  216. Dim Ax As Single
  217. Dim Ay As Single
  218. Dim Az As Single
  219. Dim Bx As Single
  220. Dim By As Single
  221. Dim Bz As Single
  222. Dim nx As Single
  223. Dim ny As Single
  224. Dim nz As Single
  225.  
  226.     Ax = Points(2).coord(1) - Points(1).coord(1)
  227.     Ay = Points(2).coord(2) - Points(1).coord(2)
  228.     Az = Points(2).coord(3) - Points(1).coord(3)
  229.     Bx = Points(3).coord(1) - Points(2).coord(1)
  230.     By = Points(3).coord(2) - Points(2).coord(2)
  231.     Bz = Points(3).coord(3) - Points(2).coord(3)
  232.     m3Cross nx, ny, nz, Ax, Ay, Az, Bx, By, Bz
  233.     plane.Initialize _
  234.         Points(1).coord(1), _
  235.         Points(1).coord(2), _
  236.         Points(1).coord(3), _
  237.         nx, ny, nz
  238. End Sub
  239.  
  240.  
  241. ' ************************************************
  242. ' Add one or more points to the polygon.
  243. ' ************************************************
  244. Public Sub AddPoint(ParamArray coord() As Variant)
  245. Dim num_pts As Integer
  246. Dim i As Integer
  247. Dim pt As Integer
  248.  
  249.     num_pts = (UBound(coord) + 1) \ 3
  250.     ReDim Preserve Points(1 To NumPts + num_pts)
  251.  
  252.     pt = 0
  253.     For i = 1 To num_pts
  254.         Points(NumPts + i).coord(1) = coord(pt)
  255.         Points(NumPts + i).coord(2) = coord(pt + 1)
  256.         Points(NumPts + i).coord(3) = coord(pt + 2)
  257.         Points(NumPts + i).coord(4) = 1#
  258.         pt = pt + 3
  259.     Next i
  260.  
  261.     NumPts = NumPts + num_pts
  262. End Sub
  263.  
  264.  
  265.  
  266. ' ************************************************
  267. ' Set constants for reflection.
  268. ' ************************************************
  269. Sub SetKr(r As Single, G As Single, B As Single)
  270.     plane.SetKr r, G, B
  271. End Sub
  272. ' ************************************************
  273. ' Set constants for diffuse reflection.
  274. ' ************************************************
  275. Sub SetKd(r As Single, G As Single, B As Single)
  276.     plane.SetKd r, G, B
  277. End Sub
  278.  
  279. ' ************************************************
  280. ' Set constants for ambient light.
  281. ' ************************************************
  282. Sub SetKa(r As Single, G As Single, B As Single)
  283.     plane.SetKa r, G, B
  284. End Sub
  285. ' ************************************************
  286. ' Set N and Ks for specular reflection.
  287. ' ************************************************
  288. Sub SetSpec(n As Single, s As Single)
  289.     plane.SetSpec n, s
  290. End Sub
  291.  
  292. ' ************************************************
  293. ' Apply a transformation matrix to the object.
  294. ' ************************************************
  295. Public Sub Apply(M() As Single)
  296. Dim i As Integer
  297.  
  298.     For i = 1 To NumPts
  299.         m3Apply Points(i).coord, M, Points(i).trans
  300.     Next i
  301.     plane.Apply M
  302. End Sub
  303.  
  304.  
  305.  
  306.  
  307.  
  308.