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