home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH13 / SRC / OBJSPH.CLS < prev    next >
Encoding:
Text File  |  1996-04-10  |  7.0 KB  |  267 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjSphere"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Private Radius As Single
  11. Private Center As Point3D
  12.  
  13. Private HitX As Single
  14. Private HitY As Single
  15. Private HitZ As Single
  16.  
  17. Private Kar As Single
  18. Private Kag As Single
  19. Private Kab As Single
  20.  
  21. Private Kdr As Single
  22. Private Kdg As Single
  23. Private Kdb As Single
  24.  
  25. Private SpecN As Single
  26. Private Ks As Single
  27.  
  28. ' ************************************************
  29. ' Apply a transformation matrix to the sphere.
  30. ' ************************************************
  31. Public Sub Apply(M() As Single)
  32.     ' Transform the center.
  33.     m3Apply Center.coord, M, Center.trans
  34. End Sub
  35. ' ************************************************
  36. ' Return the red, green, and blue components of
  37. ' the surface at the hit position.
  38. ' ************************************************
  39. Public Sub HitColor(Objects As Collection, R As Integer, G As Integer, B As Integer)
  40. Dim nx As Single
  41. Dim ny As Single
  42. Dim nz As Single
  43. Dim lx As Single
  44. Dim ly As Single
  45. Dim lz As Single
  46. Dim Vx As Single
  47. Dim Vy As Single
  48. Dim Vz As Single
  49. Dim rx As Single
  50. Dim ry As Single
  51. Dim rz As Single
  52. Dim n_len As Single
  53. Dim l_len As Single
  54. Dim v_len As Single
  55. Dim r_len As Single
  56. Dim NdotL As Single
  57. Dim RdotV As Single
  58. Dim r_dif As Single
  59. Dim g_dif As Single
  60. Dim b_dif As Single
  61. Dim r_amb As Single
  62. Dim g_amb As Single
  63. Dim b_amb As Single
  64. Dim spec As Single
  65. Dim i As Integer
  66. Dim dist As Single
  67. Dim shadowed As Boolean
  68.  
  69.     ' Find the unit vector pointing toward the light.
  70.     lx = LightSource.trans(1) - HitX
  71.     ly = LightSource.trans(2) - HitY
  72.     lz = LightSource.trans(3) - HitZ
  73.     l_len = Sqr(lx * lx + ly * ly + lz * lz)
  74.     lx = lx / l_len
  75.     ly = ly / l_len
  76.     lz = lz / l_len
  77.     ' We will use l_len later as the distance from
  78.     ' the light to the surface.
  79.  
  80.     ' Find the surface unit normal.
  81.     nx = HitX - Center.trans(1)
  82.     ny = HitY - Center.trans(2)
  83.     nz = HitZ - Center.trans(3)
  84.     n_len = Sqr(nx * nx + ny * ny + nz * nz)
  85.     nx = nx / n_len
  86.     ny = ny / n_len
  87.     nz = nz / n_len
  88.     
  89.     ' See if the light shines directly on the surface.
  90.     For i = 1 To Objects.Count
  91.         dist = Objects.Item(i).RayDistance( _
  92.             LightSource.trans(1), _
  93.             LightSource.trans(2), _
  94.             LightSource.trans(3), _
  95.             -lx, -ly, -lz)
  96.         If dist < l_len - 0.1 Then Exit For
  97.     Next i
  98.     shadowed = (i <= Objects.Count)
  99.  
  100.     ' Calculate the part due to diffuse reflection.
  101.     If shadowed Then
  102.         NdotL = -1
  103.     Else
  104.         NdotL = nx * lx + ny * ly + nz * lz
  105.     End If
  106.     If NdotL < 0 Then
  107.         ' The light does not hit the surface.
  108.         r_dif = 0
  109.         g_dif = 0
  110.         b_dif = 0
  111.         spec = 0
  112.     Else
  113.         r_dif = Kdr * NdotL
  114.         g_dif = Kdg * NdotL
  115.         b_dif = Kdb * NdotL
  116.         
  117.         ' Find the vector V from the surface to the
  118.         ' viewpoint.
  119.         Vx = EyeX - HitX
  120.         Vy = EyeY - HitY
  121.         Vz = EyeZ - HitZ
  122.         v_len = Sqr(Vx * Vx + Vy * Vy + Vz * Vz)
  123.         Vx = Vx / v_len
  124.         Vy = Vy / v_len
  125.         Vz = Vz / v_len
  126.         
  127.         ' Find vector R in the mirror direction.
  128.         rx = 2 * nx * NdotL - lx
  129.         ry = 2 * ny * NdotL - ly
  130.         rz = 2 * nz * NdotL - lz
  131.         
  132.         ' Calculate the part due to specular reflection.
  133.         RdotV = rx * Vx + ry * Vy + rz * Vz
  134.         If RdotV < 0 Then
  135.             spec = 0
  136.         Else
  137.             spec = Ks * RdotV ^ SpecN
  138.         End If
  139.     End If
  140.     
  141.     ' Calculate the part due to ambient light.
  142.     r_amb = LightIar * Kar
  143.     g_amb = LightIag * Kag
  144.     b_amb = LightIab * Kab
  145.     
  146.     ' See how intense to make the color.
  147.     R = r_amb + _
  148.         LightIir / (l_len + LightKdist) * _
  149.             (r_dif + spec)
  150.     G = g_amb + _
  151.         LightIig / (l_len + LightKdist) * _
  152.             (g_dif + spec)
  153.     B = b_amb + _
  154.         LightIib / (l_len + LightKdist) * _
  155.             (b_dif + spec)
  156. End Sub
  157.  
  158. ' ************************************************
  159. ' Compute the distance from point (px, py, pz)
  160. ' along vector <vx, vy, vz> to the sphere.
  161. '
  162. ' Save the point of intersection in
  163. ' (HitX, HitY, HitZ) for later use.
  164. ' ************************************************
  165. Public Function RayDistance(px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single) As Single
  166. Dim A As Single
  167. Dim B As Single
  168. Dim C As Single
  169. Dim Cx As Single
  170. Dim Cy As Single
  171. Dim Cz As Single
  172. Dim B24AC As Single
  173. Dim t1 As Single
  174. Dim t2 As Single
  175.  
  176.     Cx = Center.trans(1)
  177.     Cy = Center.trans(2)
  178.     Cz = Center.trans(3)
  179.  
  180.     ' Get the coefficients for the quadratic.
  181.     A = Vx * Vx + Vy * Vy + Vz * Vz
  182.     B = 2 * Vx * (px - Cx) + _
  183.         2 * Vy * (py - Cy) + _
  184.         2 * Vz * (pz - Cz)
  185.     C = Cx * Cx + Cy * Cy + Cz * Cz + _
  186.         px * px + py * py + pz * pz - _
  187.         2 * (Cx * px + Cy * py + Cz * pz) - _
  188.         Radius * Radius
  189.  
  190.     ' Solve the quadratic A*t^2 + B*t + C = 0.
  191.     B24AC = B * B - 4 * A * C
  192.     If B24AC < 0 Then
  193.         RayDistance = INFINITY
  194.         Exit Function
  195.     ElseIf B24AC = 0 Then
  196.         t1 = -B / 2 / A
  197.     Else
  198.         B24AC = Sqr(B24AC)
  199.         t1 = (-B + B24AC) / 2 / A
  200.         t2 = (-B - B24AC) / 2 / A
  201.         ' Use only positive t values.
  202.         If t1 < 0 Then t1 = t2
  203.         If t2 < 0 Then t2 = t1
  204.         ' Use the smaller t value.
  205.         If t1 > t2 Then t1 = t2
  206.     End If
  207.  
  208.     ' If there is no positive t value, there's no
  209.     ' intersection in this direction.
  210.     If t1 < 0 Then
  211.         RayDistance = INFINITY
  212.         Exit Function
  213.     End If
  214.     
  215.     ' Compute the actual hit location.
  216.     HitX = px + t1 * Vx
  217.     HitY = py + t1 * Vy
  218.     HitZ = pz + t1 * Vz
  219.     
  220.     ' Compute the distance from (px, py, pz).
  221.     A = px - HitX
  222.     B = py - HitY
  223.     C = pz - HitZ
  224.     RayDistance = Sqr(A * A + B * B + C * C)
  225. End Function
  226.  
  227. ' ************************************************
  228. ' Set the center.
  229. ' ************************************************
  230. Public Sub Initialize(R As Single, x As Single, y As Single, z As Single)
  231.     Radius = R
  232.     Center.coord(1) = x
  233.     Center.coord(2) = y
  234.     Center.coord(3) = z
  235.     Center.coord(4) = 1
  236. End Sub
  237.  
  238.  
  239. ' ************************************************
  240. ' Set N and Ks for specular reflection.
  241. ' ************************************************
  242. Sub SetSpec(n As Single, s As Single)
  243.     SpecN = n
  244.     Ks = s
  245. End Sub
  246.  
  247. ' ************************************************
  248. ' Set constants for diffuse reflection.
  249. ' ************************************************
  250. Sub SetKd(R As Single, G As Single, B As Single)
  251.     Kdr = R
  252.     Kdg = G
  253.     Kdb = B
  254. End Sub
  255.  
  256. ' ************************************************
  257. ' Set constants for ambient light.
  258. ' ************************************************
  259. Sub SetKa(R As Single, G As Single, B As Single)
  260.     Kar = R
  261.     Kag = G
  262.     Kab = B
  263. End Sub
  264.  
  265.  
  266.  
  267.