home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH13 / SRC / OBJCYL.CLS < prev    next >
Encoding:
Text File  |  1996-04-10  |  8.8 KB  |  335 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjCylinder"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. ' Point1 and Point2 are points at each end of the
  11. ' cylinder's axis.
  12. Private Point1 As Point3D
  13. Private Point2 As Point3D
  14. Private Radius As Single
  15.  
  16. ' The axis.
  17. Private Ax As Single
  18. Private Ay As Single
  19. Private Az As Single
  20.  
  21. ' The radii vectors.
  22. Private V1x As Single
  23. Private V1y As Single
  24. Private V1z As Single
  25. Private V2x As Single
  26. Private V2y As Single
  27. Private V2z As Single
  28.  
  29. Private HitX As Single
  30. Private HitY As Single
  31. Private HitZ As Single
  32. Private HitT As Single
  33.  
  34. Private Kar As Single
  35. Private Kag As Single
  36. Private Kab As Single
  37.  
  38. Private Kdr As Single
  39. Private Kdg As Single
  40. Private Kdb As Single
  41.  
  42. Private SpecN As Single
  43. Private Ks As Single
  44.  
  45. ' ************************************************
  46. ' Apply a transformation matrix to the plane.
  47. ' ************************************************
  48. Public Sub Apply(M() As Single)
  49.     ' Transform the points.
  50.     m3Apply Point1.coord, M, Point1.trans
  51.     m3Apply Point2.coord, M, Point2.trans
  52. End Sub
  53.  
  54. ' ************************************************
  55. ' Return the red, green, and blue components of
  56. ' the surface at the hit position.
  57. ' ************************************************
  58. Public Sub HitColor(Objects As Collection, R As Integer, G As Integer, B As Integer)
  59. Dim Vx As Single
  60. Dim Vy As Single
  61. Dim Vz As Single
  62. Dim nx As Single
  63. Dim ny As Single
  64. Dim nz As Single
  65. Dim lx As Single
  66. Dim ly As Single
  67. Dim lz As Single
  68. Dim rx As Single
  69. Dim ry As Single
  70. Dim rz As Single
  71. Dim n_len As Single
  72. Dim l_len As Single
  73. Dim v_len As Single
  74. Dim r_len As Single
  75. Dim NdotL As Single
  76. Dim RdotV As Single
  77. Dim r_dif As Single
  78. Dim g_dif As Single
  79. Dim b_dif As Single
  80. Dim r_amb As Single
  81. Dim g_amb As Single
  82. Dim b_amb As Single
  83. Dim spec As Single
  84. Dim i As Integer
  85. Dim dist As Single
  86. Dim shadowed As Boolean
  87.  
  88.     ' Find the unit vector pointing toward the light.
  89.     lx = LightSource.trans(1) - HitX
  90.     ly = LightSource.trans(2) - HitY
  91.     lz = LightSource.trans(3) - HitZ
  92.     l_len = Sqr(lx * lx + ly * ly + lz * lz)
  93.     lx = lx / l_len
  94.     ly = ly / l_len
  95.     lz = lz / l_len
  96.     ' We will use l_len later as the distance from
  97.     ' the light to the surface.
  98.  
  99.     ' Find the surface unit normal.
  100.     Vx = Point2.trans(1) - Point1.trans(1)
  101.     Vy = Point2.trans(2) - Point1.trans(2)
  102.     Vz = Point2.trans(3) - Point1.trans(3)
  103.     nx = HitX - (Point1.trans(1) + HitT * Vx)
  104.     ny = HitY - (Point1.trans(2) + HitT * Vy)
  105.     nz = HitZ - (Point1.trans(3) + HitT * Vz)
  106.     n_len = Sqr(nx * nx + ny * ny + nz * nz)
  107.     nx = nx / n_len
  108.     ny = ny / n_len
  109.     nz = nz / n_len
  110.     
  111.     ' Find the vector V from the surface to the
  112.     ' viewpoint.
  113.     Vx = EyeX - HitX
  114.     Vy = EyeY - HitY
  115.     Vz = EyeZ - HitZ
  116.     v_len = Sqr(Vx * Vx + Vy * Vy + Vz * Vz)
  117.     Vx = Vx / v_len
  118.     Vy = Vy / v_len
  119.     Vz = Vz / v_len
  120.  
  121.     ' See if the light shines directly on the surface.
  122.     For i = 1 To Objects.Count
  123.         dist = Objects.Item(i).RayDistance( _
  124.             LightSource.trans(1), _
  125.             LightSource.trans(2), _
  126.             LightSource.trans(3), _
  127.             -lx, -ly, -lz)
  128.         If dist < l_len - 0.1 Then Exit For
  129.     Next i
  130.     shadowed = (i <= Objects.Count)
  131.  
  132.     ' Calculate the part due to diffuse reflection.
  133.     If shadowed Then
  134.         ' The light does not hit the surface.
  135.         r_dif = 0
  136.         g_dif = 0
  137.         b_dif = 0
  138.         spec = 0
  139.     Else
  140.         ' Treat backface planes as normal planes.
  141.         NdotL = Abs(nx * lx + ny * ly + nz * lz)
  142.         
  143.         r_dif = Kdr * NdotL
  144.         g_dif = Kdg * NdotL
  145.         b_dif = Kdb * NdotL
  146.         
  147.         ' Find vector R in the mirror direction.
  148.         rx = 2 * nx * NdotL - lx
  149.         ry = 2 * ny * NdotL - ly
  150.         rz = 2 * nz * NdotL - lz
  151.         
  152.         ' Calculate the part due to specular reflection.
  153.         RdotV = rx * Vx + ry * Vy + rz * Vz
  154.         If RdotV < 0 Then
  155.             spec = 0
  156.         Else
  157.             spec = Ks * RdotV ^ SpecN
  158.         End If
  159.     End If
  160.     
  161.     ' Calculate the part due to ambient light.
  162.     r_amb = LightIar * Kar
  163.     g_amb = LightIag * Kag
  164.     b_amb = LightIab * Kab
  165.     
  166.     ' See how intense to make the color.
  167.     R = r_amb + _
  168.         LightIir / (l_len + LightKdist) * _
  169.             (r_dif + spec)
  170.     G = g_amb + _
  171.         LightIig / (l_len + LightKdist) * _
  172.             (g_dif + spec)
  173.     B = b_amb + _
  174.         LightIib / (l_len + LightKdist) * _
  175.             (b_dif + spec)
  176. End Sub
  177.  
  178. ' ************************************************
  179. ' Compute the distance from point (x3, y3, z3)
  180. ' along vector <wx, wy, wz> to the cylinder.
  181. '
  182. ' Save the point of intersection in
  183. ' (HitX, HitY, HitZ) for later use.
  184. ' ************************************************
  185. Public Function RayDistance(x3 As Single, y3 As Single, z3 As Single, Wx As Single, Wy As Single, Wz As Single) As Single
  186. Dim x1 As Single
  187. Dim y1 As Single
  188. Dim z1 As Single
  189. Dim Vx As Single
  190. Dim Vy As Single
  191. Dim Vz As Single
  192. Dim Vlen2 As Single
  193. Dim WdotV As Single
  194. Dim A As Single
  195. Dim B As Single
  196. Dim Cx As Single
  197. Dim Cy As Single
  198. Dim Cz As Single
  199. Dim dx As Single
  200. Dim dy As Single
  201. Dim dz As Single
  202. Dim A1 As Single
  203. Dim B1 As Single
  204. Dim C1 As Single
  205. Dim B24AC As Single
  206. Dim u1 As Single
  207. Dim u2 As Single
  208.  
  209.     ' Find the axis vector.
  210.     Vx = Point2.trans(1) - Point1.trans(1)
  211.     Vy = Point2.trans(2) - Point1.trans(2)
  212.     Vz = Point2.trans(3) - Point1.trans(3)
  213.     
  214.     ' Find A and B for t = A * u + B.
  215.     Vlen2 = Vx * Vx + Vy * Vy + Vz * Vz
  216.     WdotV = Wx * Vx + Wy * Vy + Wz * Vz
  217.     A = WdotV / Vlen2
  218.     
  219.     x1 = Point1.trans(1)
  220.     y1 = Point1.trans(2)
  221.     z1 = Point1.trans(3)
  222.     B = (Vx * (x3 - x1) + _
  223.          Vy * (y3 - y1) + _
  224.          Vz * (z3 - z1)) / Vlen2
  225.         
  226.     ' Solve for u.
  227.     Cx = Wx - Vx * A
  228.     Cy = Wy - Vy * A
  229.     Cz = Wz - Vz * A
  230.     dx = x3 - x1 - Vx * B
  231.     dy = y3 - y1 - Vy * B
  232.     dz = z3 - z1 - Vz * B
  233.     A1 = Cx * Cx + Cy * Cy + Cz * Cz
  234.     B1 = 2 * (Cx * dx + Cy * dy + Cz * dz)
  235.     C1 = dx * dx + dy * dy + dz * dz - Radius * Radius
  236.     ' Solve the quadratic A1*u^2 + B1*u + C1 = 0.
  237.     B24AC = B1 * B1 - 4 * A1 * C1
  238.     If B24AC < 0 Then
  239.         RayDistance = INFINITY
  240.         Exit Function
  241.     ElseIf B24AC = 0 Then
  242.         u1 = -B1 / 2 / A1
  243.     Else
  244.         B24AC = Sqr(B24AC)
  245.         u1 = (-B1 + B24AC) / 2 / A1
  246.         u2 = (-B1 - B24AC) / 2 / A1
  247.         ' Use only positive t values.
  248.         If u1 < 0 Then u1 = u2
  249.         If u2 < 0 Then u2 = u1
  250.         ' Use the smaller t value.
  251.         If u1 > u2 Then u1 = u2
  252.     End If
  253.     
  254.     ' If there is no positive u value, there's no
  255.     ' intersection in this direction.
  256.     If u1 < 0 Then
  257.         RayDistance = INFINITY
  258.         Exit Function
  259.     End If
  260.     
  261.     ' See where on the cylinder this is.
  262.     HitT = u1 * A + B
  263.     ' If this is not between Point1 and Point2,
  264.     ' ignore it.
  265.     If HitT < 0 Or HitT > 1 Then
  266.         RayDistance = INFINITY
  267.         Exit Function
  268.     End If
  269.     
  270.     ' Compute the actual hit location.
  271.     HitX = x3 + u1 * Wx
  272.     HitY = y3 + u1 * Wy
  273.     HitZ = z3 + u1 * Wz
  274.  
  275.     ' Compute the distance from (x3, y3, z3).
  276.     A1 = x3 - HitX
  277.     B1 = y3 - HitY
  278.     C1 = z3 - HitZ
  279.     RayDistance = Sqr(A1 * A1 + B1 * B1 + C1 * C1)
  280. End Function
  281.  
  282. ' ************************************************
  283. ' Initialize the data.
  284. ' ************************************************
  285. Public Sub Initialize(R As Single, p1x As Single, p1y As Single, p1z As Single, p2x As Single, p2y As Single, p2z As Single)
  286.     Radius = R
  287.     Point1.coord(1) = p1x
  288.     Point1.coord(2) = p1y
  289.     Point1.coord(3) = p1z
  290.     Point1.coord(4) = 1
  291.     Point2.coord(1) = p2x
  292.     Point2.coord(2) = p2y
  293.     Point2.coord(3) = p2z
  294.     Point2.coord(4) = 1
  295. End Sub
  296.  
  297.  
  298. ' ************************************************
  299. ' Set N and Ks for specular reflection.
  300. ' ************************************************
  301. Sub SetSpec(n As Single, s As Single)
  302.     SpecN = n
  303.     Ks = s
  304. End Sub
  305.  
  306. ' ************************************************
  307. ' Return the latest Hit location.
  308. ' ************************************************
  309. Public Sub HitLocation(x As Single, y As Single, z As Single)
  310.     x = HitX
  311.     y = HitY
  312.     z = HitZ
  313. End Sub
  314.  
  315. ' ************************************************
  316. ' Set constants for diffuse reflection.
  317. ' ************************************************
  318. Sub SetKd(R As Single, G As Single, B As Single)
  319.     Kdr = R
  320.     Kdg = G
  321.     Kdb = B
  322. End Sub
  323.  
  324. ' ************************************************
  325. ' Set constants for ambient light.
  326. ' ************************************************
  327. Sub SetKa(R As Single, G As Single, B As Single)
  328.     Kar = R
  329.     Kag = G
  330.     Kab = B
  331. End Sub
  332.  
  333.  
  334.  
  335.