home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code1 / fade / fade.bas next >
BASIC Source File  |  1992-12-10  |  2KB  |  47 lines
  1. Option Explicit
  2.  
  3. '  Data type used by FillRect
  4. Type RECT
  5.     Left As Integer
  6.     Top As Integer
  7.     Right As Integer
  8.     Bottom As Integer
  9. End Type
  10.  
  11. '  API Functions used to create solid brush and draw brush on form
  12. Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
  13. Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As RECT, ByVal hBrush As Integer) As Integer
  14. Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  15.  
  16. Dim hBrush%
  17.  
  18. Sub FadeForm (TheForm As Form)
  19.     Dim FormHeight%, Blue%, StepInterval%, X%, RetVal%, OldMode%
  20.     Dim FillArea As RECT
  21.     OldMode = TheForm.ScaleMode
  22.     TheForm.ScaleMode = 3  'Pixel
  23.     FormHeight = TheForm.ScaleHeight
  24. ' Divide the form into 63 regions
  25.     StepInterval = FormHeight \ 63
  26.     Blue = 255
  27.     FillArea.Left = 0
  28.     FillArea.Right = TheForm.ScaleWidth
  29.     FillArea.Top = 0
  30.     FillArea.Bottom = StepInterval
  31.     For X = 1 To 63
  32.         hBrush% = CreateSolidBrush(RGB(0, 0, Blue))
  33.         RetVal% = FillRect(TheForm.hDC, FillArea, hBrush)
  34.         RetVal% = DeleteObject(hBrush)
  35.         Blue = Blue - 4
  36.         FillArea.Top = FillArea.Bottom
  37.         FillArea.Bottom = FillArea.Bottom + StepInterval
  38.     Next
  39. ' Fill the remainder of the form with black
  40.     FillArea.Bottom = FillArea.Bottom + 63
  41.     hBrush% = CreateSolidBrush(RGB(0, 0, 0))
  42.     RetVal% = FillRect(TheForm.hDC, FillArea, hBrush)
  43.     RetVal% = DeleteObject(hBrush)
  44.     TheForm.ScaleMode = OldMode
  45. End Sub
  46.  
  47.