home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH13 / SRC / OBJDSKR.CLS < prev    next >
Encoding:
Text File  |  1996-04-15  |  3.4 KB  |  121 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjDisk"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. ' The plane that contains the disk.
  11. Private plane As New ObjPlane
  12.  
  13. Private Center As Point3D   ' Coordinates of center.
  14. Private Radius As Integer   ' Radius.
  15.  
  16. ' ************************************************
  17. ' Set constants for reflection.
  18. ' ************************************************
  19. Sub SetKr(r As Single, G As Single, B As Single)
  20.     plane.SetKr r, G, B
  21. End Sub
  22.  
  23. ' ************************************************
  24. ' Return the red, green, and blue components of
  25. ' the surface at the hit position.
  26. ' ************************************************
  27. Public Sub HitColor(depth As Integer, Objects As Collection, r As Integer, G As Integer, B As Integer)
  28.     plane.HitColor depth, Objects, r, G, B
  29. End Sub
  30.  
  31. ' ************************************************
  32. ' Compute the distance from point (px, py, pz)
  33. ' along vector <vx, vy, vz> to the disk.
  34. ' ************************************************
  35. Public Function RayDistance(px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single) As Single
  36. Dim dist As Single
  37. Dim x As Single
  38. Dim y As Single
  39. Dim z As Single
  40. Dim dx As Single
  41. Dim dy As Single
  42. Dim dz As Single
  43.  
  44.     ' Find the distance to the plane.
  45.     dist = plane.RayDistance(px, py, pz, Vx, Vy, Vz)
  46.     
  47.     ' If there is no good intersection with the
  48.     ' plane, there's none with the disk.
  49.     If dist >= INFINITY Then
  50.         RayDistance = INFINITY
  51.         Exit Function
  52.     End If
  53.  
  54.     ' See if the point of intersection lies within
  55.     ' the disk.
  56.     
  57.     ' Get the hit location.
  58.     plane.HitLocation x, y, z
  59.  
  60.     ' See if the point lies within distance Radius
  61.     ' of the center.
  62.     dx = Center.trans(1) - x
  63.     dy = Center.trans(2) - y
  64.     dz = Center.trans(3) - z
  65.     If Sqr(dx * dx + dy * dy + dz * dz) > Radius Then
  66.         RayDistance = INFINITY
  67.         Exit Function
  68.     End If
  69.     
  70.     RayDistance = dist
  71. End Function
  72.  
  73.  
  74.  
  75. ' ***********************************************
  76. ' Define the plane that contains the disk.
  77. ' ***********************************************
  78. Public Sub Initialize(r As Single, cx As Single, cy As Single, cz As Single, nx As Single, ny As Single, nz As Single)
  79.     Radius = r
  80.     Center.coord(1) = cx
  81.     Center.coord(2) = cy
  82.     Center.coord(3) = cz
  83.     Center.coord(4) = 1
  84.     plane.Initialize cx, cy, cz, nx, ny, nz
  85. End Sub
  86.  
  87.  
  88.  
  89. ' ************************************************
  90. ' Set constants for diffuse reflection.
  91. ' ************************************************
  92. Sub SetKd(r As Single, G As Single, B As Single)
  93.     plane.SetKd r, G, B
  94. End Sub
  95. ' ************************************************
  96. ' Set constants for ambient light.
  97. ' ************************************************
  98. Sub SetKa(r As Single, G As Single, B As Single)
  99.     plane.SetKa r, G, B
  100. End Sub
  101. ' ************************************************
  102. ' Set N and Ks for specular reflection.
  103. ' ************************************************
  104. Sub SetSpec(n As Single, s As Single)
  105.     plane.SetSpec n, s
  106. End Sub
  107.  
  108. ' ************************************************
  109. ' Apply a transformation matrix to the object.
  110. ' ************************************************
  111. Public Sub Apply(M() As Single)
  112.     m3Apply Center.coord, M, Center.trans
  113.     plane.Apply M
  114. End Sub
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.