home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD80277222000.psc / mdlLight.bas < prev    next >
Encoding:
BASIC Source File  |  2000-07-23  |  3.1 KB  |  85 lines
  1. Attribute VB_Name = "mdlLight"
  2.  
  3. 'APIs:
  4. Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  5. Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  6.  
  7. 'Variables (these are needed for GetRGBs):
  8. Dim Red As Long
  9. Dim Green As Long
  10. Dim Blue As Long
  11.  
  12. Public Sub DrawLight(Target As Long, X As Integer, Y As Integer, RedB As Byte, GreenB As Byte, BlueB As Byte, Radius As Long, NumberOfSteps As Long)
  13.     Dim cX As Long 'X counter
  14.     Dim cY As Long 'Y counter
  15.     Dim TempColor As Long
  16.     Dim TempRadius As Integer
  17.     
  18.     'This boolean array holds the state of
  19.     'each pixel (if it was drawn or not).
  20.     'It's useful to not draw a pixel twice.
  21.     Dim Done() As Boolean
  22.     ReDim Done(-Radius To Radius, -Radius To Radius)
  23.     
  24.     For i = 1 To NumberOfSteps
  25.         
  26.         'Update "TempRadius" (the radius of the
  27.         'circle that is currently being drawn)
  28.         TempRadius = Radius / NumberOfSteps * i
  29.         
  30.         For cX = -TempRadius To TempRadius
  31.             For cY = -TempRadius To TempRadius
  32.                 If Not Done(cX, cY) Then 'The pixel hasn't been drawn yet
  33.                     'Next is the formula for getting the circle
  34.                     If (cX * cX) + (cY * cY) <= TempRadius * TempRadius Then
  35.                         'Get the pixel and extract RGBs
  36.                         TempColor = GetPixel(Target, cX + X, cY + Y)
  37.                         GetRGBs TempColor
  38.                         
  39.                         'Increase RGB values with the given brightnesses
  40.                         Red = Red + RedB * (NumberOfSteps - i)
  41.                         If Red > 255 Then Red = 255
  42.                         
  43.                         Green = Green + GreenB * (NumberOfSteps - i)
  44.                         If Green > 255 Then Green = 255
  45.                         
  46.                         Blue = Blue + BlueB * (NumberOfSteps - i)
  47.                         If Blue > 255 Then Blue = 255
  48.                         
  49.                         'Draw pixel
  50.                         SetPixel Target, cX + X, cY + Y, RGB(Red, Green, Blue)
  51.                         
  52.                         'This pixel has been drawn, so write it in the
  53.                         'array (so it won't be drawn twice)
  54.                         Done(cX, cY) = True
  55.                     End If
  56.                 End If
  57.             Next cY
  58.         Next cX
  59.     Next i
  60. End Sub
  61.  
  62.     ' This function extracts the Red, Green and Blue
  63.     'values from a color to 3 variables with their
  64.     'names. You may keep it as well, but please give
  65.     'me some credit for it too ;)
  66.     'By the way, this function isn't very exact, so
  67.     'you may end up with the green and blue values
  68.     'not as they should (plus or minus 1 or 2).
  69.  
  70. Public Sub GetRGBs(RGBVal As Long)
  71.  
  72.     If RGBVal = 16777215 Then
  73.         Red = 255
  74.         Green = 255
  75.         Blue = 255
  76.         Exit Sub
  77.     End If
  78.  
  79.     Red = RGBVal And 255
  80.     Green = RGBVal / 256 And 255
  81.     Blue = RGBVal / 65536 And 255
  82.     
  83. End Sub
  84.  
  85.