home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / gradti_1 / mdlgradt.bas < prev    next >
Encoding:
BASIC Source File  |  1998-06-07  |  3.4 KB  |  117 lines
  1. Attribute VB_Name = "mdlGradTitle"
  2. Option Explicit
  3.  
  4. Public Const GT_HOW = "LtoR"
  5. 'Public Const GT_HOW = "TtoB"
  6.     
  7.     ' Values for GT_HOW are:
  8.      ' TtoB Is Specified Color to Black Going Down
  9.      ' BlueLtoR is fading Left to Right Select Color
  10.         ' to Black
  11.     ' Just Uncomment the one you want and
  12.     ' Comment the other
  13.     
  14.     
  15. ' Color values for the Title Bar, They are
  16. ' RGB so each is 0 to 255
  17. Public Const GT_RED = 0  ' The Red Value
  18. Public Const GT_GREEN = 0  ' The Green Value
  19. Public Const GT_BLUE = 255 ' The Blue Value
  20.  
  21.  
  22. ' Don't Comment Out any of the lines below here!!!!!
  23. Public Const GT_SPACERVAL = 40
  24.  
  25. Public Type RECT
  26.        Left As Long
  27.        Top As Long
  28.        Right As Long
  29.        Bottom As Long
  30. End Type
  31.  
  32. Public Type POINTAPI
  33.        x As Long
  34.        y As Long
  35. End Type
  36.  
  37. Public Const COLOR_ACTIVECAPTION = 2
  38. Public Const SM_CXDLGFRAME = 7
  39. Public Const SM_CYDLGFRAME = 8
  40. Public Const PLANES = 14 ' Number of planes
  41. Public Const BITSPIXEL = 12 ' Number of bits per pixel
  42.  
  43.  
  44. Public Declare Function GetWindowRect Lib "user32" _
  45.        (ByVal hwnd As Long, lpRect As RECT) As Long
  46.  
  47. Public Declare Function GetSystemMetrics Lib "user32" _
  48.        (ByVal nIndex As Long) As Long
  49.  
  50. Public Declare Function DrawFocusRect Lib "user32" _
  51.        (ByVal hDC As Long, lpRect As RECT) As Long
  52.  
  53. Public Declare Function ClientToScreen Lib "user32" _
  54.        (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  55.  
  56. Public Declare Function GetDC Lib "user32" _
  57.        (ByVal hwnd As Long) As Long
  58.  
  59. Public Declare Function ReleaseDC Lib "user32" _
  60.        (ByVal hwnd As Long, ByVal hDC As Long) As Long
  61.  
  62.  
  63. Declare Function CreateSolidBrush Lib "gdi32" _
  64.        (ByVal crColor As Long) As Long
  65.  
  66. Declare Function DeleteObject Lib "gdi32" _
  67.        (ByVal hObject As Long) As Long
  68.  
  69. Declare Function GetDeviceCaps Lib "gdi32" _
  70.        (ByVal hDC As Long, ByVal nIndex As Long) As Long
  71.  
  72. Declare Function FillRect Lib "user32" _
  73.        (ByVal hDC As Long, lpRect As RECT, _
  74.        ByVal hBrush As Long) As Long
  75.  
  76.         
  77. Public tpoint As POINTAPI
  78. Public temp As POINTAPI
  79. Public dpoint As POINTAPI
  80. Public fbox As RECT
  81. Public tbox As RECT
  82. Public oldbox As RECT
  83. Public TwipsPerPixelX
  84. Public TwipsPerPixelY
  85.  
  86.  
  87. Public Sub MakeGrad(PicBoxName As PictureBox, Orientation%, RStart%, GStart%, BStart%, RInc%, GInc%, BInc%)
  88.     Dim x As Integer, y As Integer, z As Integer, Cycles As Integer
  89.     Dim R%, G%, B%
  90.     R% = RStart%: G% = GStart%: B% = BStart%
  91.     If Orientation% = 0 Then
  92.         Cycles = PicBoxName.ScaleHeight \ 100
  93.     Else
  94.         Cycles = PicBoxName.ScaleWidth \ 100
  95.     End If
  96.     
  97.     For z = 1 To 100
  98.         x = x + 1
  99.         Select Case Orientation
  100.             Case 0: 'Top to Bottom
  101.                 If x > PicBoxName.ScaleHeight Then Exit For
  102.                 PicBoxName.Line (0, x)-(PicBoxName.Width, x + Cycles - 1), RGB(R%, G%, B%), BF
  103.             Case 1: 'Left to Right
  104.                 If x > PicBoxName.ScaleWidth Then Exit For
  105.                 PicBoxName.Line (x, 0)-(x + Cycles - 1, PicBoxName.Height), RGB(R%, G%, B%), BF
  106.         End Select
  107.         x = x + Cycles
  108.         R% = R% + RInc%: G% = G% + GInc%: B% = B% + BInc%
  109.         If R% > 255 Then R% = 255
  110.         If R% < 0 Then R% = 0
  111.         If G% > 255 Then G% = 255
  112.         If G% < 0 Then G% = 0
  113.         If B% > 255 Then B% = 255
  114.         If B% < 0 Then B% = 0
  115.     Next z
  116. End Sub
  117.