home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH13 / SRC / RRAY2.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-01-08  |  5.5 KB  |  127 lines
  1. Attribute VB_Name = "Ray"
  2. Option Explicit
  3.  
  4. ' The collection of objects in the scene.
  5. Global Objects As Collection
  6.  
  7. ' Viewing position.
  8. Global EyeX As Single
  9. Global EyeY As Single
  10. Global EyeZ As Single
  11.  
  12. ' Location of light source.
  13. Global LightSource As Point3D
  14. Global LightIar As Single
  15. Global LightIag As Single
  16. Global LightIab As Single
  17. Global LightIir As Single
  18. Global LightIig As Single
  19. Global LightIib As Single
  20. Global BackR As Long
  21. Global BackG As Long
  22. Global BackB As Long
  23.  
  24. ' Constants for the surfaces.
  25. Global LightKdist As Single ' Distance.
  26.  
  27. Type PALETTEENTRY
  28.     peRed As Byte
  29.     peGreen As Byte
  30.     peBlue As Byte
  31.     peFlags As Byte
  32. End Type
  33. Public Const PC_EXPLICIT = &H2      ' Match to system palette index.
  34. Public Const PC_NOCOLLAPSE = &H4    ' Do not match color existing entries.
  35.  
  36. ' GetDeviceCaps constants.
  37. Global Const RASTERCAPS = 38    ' Raster device capabilities.
  38. Global Const RC_PALETTE = &H100 ' Has palettes.
  39. Global Const NUMRESERVED = 106  ' # reserved entries in palette.
  40. Global Const SIZEPALETTE = 104  ' Size of system palette.
  41.  
  42. #If Win32 Then  ' 32-bit VB.
  43.     Type BITMAP ' 24 bytes
  44.         bmType As Long
  45.         bmWidth As Long
  46.         bmHeight As Long
  47.         bmWidthBytes As Long
  48.         bmPlanes As Integer
  49.         bmBitsPixel As Integer
  50.         bmBits As Long
  51.     End Type
  52.     Global Const BITMAP_SIZE = 24
  53.     Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Integer, ByVal nIndex As Integer) As Integer
  54.     Declare Function ResizePalette Lib "gdi32" (ByVal hPalette As Integer, ByVal NumEntries As Integer) As Integer
  55.     Declare Function SetPaletteEntries Lib "gdi32" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  56.     Declare Function GetPaletteEntries Lib "gdi32" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  57.     Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  58.     Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
  59.     Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Integer, ByVal dwCount As Long, lpBits As Any) As Long
  60.     Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Integer, ByVal dwCount As Long, lpBits As Any) As Long
  61.     Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  62.     Declare Function GetNearestPaletteIndex Lib "gdi32" (ByVal hPalette As Integer, ByVal crColor As Long) As Integer
  63. #Else           ' 16-bit VB.
  64.     Type BITMAP ' 14 bytes
  65.         bmType As Integer
  66.         bmWidth As Integer
  67.         bmHeight As Integer
  68.         bmWidthBytes As Integer
  69.         bmPlanes As String * 1
  70.         bmBitsPixel As String * 1
  71.         bmBits As Long
  72.     End Type
  73.     Global Const BITMAP_SIZE = 14
  74.     Declare Function GetDeviceCaps Lib "GDI" (ByVal hdc As Integer, ByVal nIndex As Integer) As Integer
  75.     Declare Function ResizePalette Lib "GDI" (ByVal hPalette As Integer, ByVal NumEntries As Integer) As Integer
  76.     Declare Function SetPaletteEntries Lib "GDI" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  77.     Declare Function GetPaletteEntries Lib "GDI" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  78.     Declare Function GetSystemPaletteEntries Lib "GDI" (ByVal hdc As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  79.     Declare Function RealizePalette Lib "User" (ByVal hdc As Integer) As Integer
  80.     Declare Function GetBitmapBits Lib "GDI" (ByVal hBitmap As Integer, ByVal dwCount As Long, lpBits As Any) As Long
  81.     Declare Function SetBitmapBits Lib "GDI" (ByVal hBitmap As Integer, ByVal dwCount As Long, lpBits As Any) As Long
  82.     Declare Function GetObject Lib "GDI" (ByVal hObject As Integer, ByVal nCount As Integer, lpObject As Any) As Integer
  83.     Declare Function GetNearestPaletteIndex Lib "GDI" (ByVal hPalette As Integer, ByVal crColor As Long) As Integer
  84. #End If
  85.  
  86. ' ************************************************
  87. ' Return the pixel color given by tracing from
  88. ' point (px, py, pz) in direction <vx, vy, vz>.
  89. ' ************************************************
  90. Sub TraceRay(depth As Integer, px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single, r As Integer, G As Integer, B As Integer)
  91. Dim i As Integer
  92. Dim best_i As Integer
  93. Dim best_dist As Single
  94. Dim dist As Single
  95.  
  96.     If Objects.Count < 1 Then Exit Sub
  97.     
  98.     ' Find the object that's closest.
  99.     best_dist = INFINITY
  100.     best_i = -1
  101.     For i = 1 To Objects.Count
  102.         dist = Objects.Item(i).RayDistance( _
  103.             px, py, pz, Vx, Vy, Vz)
  104.         If best_dist > dist Then
  105.             best_dist = dist
  106.             best_i = i
  107.         End If
  108.     Next i
  109.  
  110.     ' If we hit nothing, return the background color.
  111.     If best_i < 1 Then
  112.         r = BackR
  113.         G = BackG
  114.         B = BackB
  115.         Exit Sub
  116.     End If
  117.     
  118.     ' Compute the color at that point.
  119.     Objects.Item(best_i).HitColor depth, Objects, r, G, B
  120.  
  121.     ' This is a problem for some values of LightKdist.
  122.     If r < 0 Then r = 0
  123.     If G < 0 Then G = 0
  124.     If B < 0 Then B = 0
  125. End Sub
  126.  
  127.