home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / fade / fade.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  1.8 KB  |  56 lines
  1. Option Explicit
  2. ' Copyright (c) 1994 Jwpc 1995, inc.
  3.  
  4.  ' this can be displayed in Super VGA, etc. colors!
  5.  
  6.  ' changes for each amt. of colors!
  7.  ' Change where the word RED or BLUE is, in the order of the RGB order.
  8.  
  9.  '   ......RGB(Blue,0,0) = 255 of RED!
  10.  '   ......RGB(0,0,Blue) = 255 of BLUE!
  11.  
  12. '  Data type used by FillRect
  13. Type RECT
  14.     Left As Integer
  15.     Top As Integer
  16.     Right As Integer
  17.     Bottom As Integer
  18. End Type
  19.  
  20. '  API Functions used to create solid brush and draw brush on form
  21. Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
  22. Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As RECT, ByVal hBrush As Integer) As Integer
  23. Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  24.  
  25. Dim hBrush%
  26.  
  27. Sub fadeform (TheForm As Form)
  28.     Dim FormHeight%, red%, StepInterval%, X%, RetVal%, OldMode%
  29.     Dim FillArea As RECT
  30.     OldMode = TheForm.ScaleMode
  31.     TheForm.ScaleMode = 3  'Pixel
  32.     FormHeight = TheForm.ScaleHeight
  33. ' Divide the form into 63 regions
  34.     StepInterval = FormHeight \ 63
  35.     red = 255
  36.     FillArea.Left = 0
  37.     FillArea.Right = TheForm.ScaleWidth
  38.     FillArea.Top = 0
  39.     FillArea.Bottom = StepInterval
  40.     For X = 1 To 63
  41.         hBrush% = CreateSolidBrush(RGB(0, 0, red))
  42.         RetVal% = FillRect(TheForm.hDC, FillArea, hBrush)
  43.         RetVal% = DeleteObject(hBrush)
  44.         red = red - 4
  45.         FillArea.Top = FillArea.Bottom
  46.         FillArea.Bottom = FillArea.Bottom + StepInterval
  47.     Next
  48. ' Fill the remainder of the form with black
  49.     FillArea.Bottom = FillArea.Bottom + 63
  50.     hBrush% = CreateSolidBrush(RGB(0, 0, 0))
  51.     RetVal% = FillRect(TheForm.hDC, FillArea, hBrush)
  52.     RetVal% = DeleteObject(hBrush)
  53.     TheForm.ScaleMode = OldMode
  54. End Sub
  55.  
  56.