home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / Free / Prg / VB_MP3.exe / modGradient.bas < prev    next >
Encoding:
BASIC Source File  |  1998-08-31  |  17.4 KB  |  407 lines
  1. Attribute VB_Name = "modGradient"
  2. Option Explicit
  3. DefLng A-Z
  4. Dim GradhWnd As Long, GradIcon As Long
  5. Dim OldGradProc As Long
  6. Dim DrawDC As Long, tmpDC As Long
  7. Dim hRgn As Long
  8. Dim tmpGradFont As Long
  9. Public Type DRAWTEXTPARAMS
  10.     cbSize As Long
  11.     iTabLength As Long
  12.     iLeftMargin As Long
  13.     iRightMargin As Long
  14.     uiLengthDrawn As Long
  15. End Type
  16. Public Type RECT
  17.         Left As Long
  18.         Top As Long
  19.         Right As Long
  20.         Bottom As Long
  21. End Type
  22. Public Type LOGFONT
  23.         lfHeight As Long
  24.         lfWidth As Long
  25.         lfEscapement As Long
  26.         lfOrientation As Long
  27.         lfWeight As Long
  28.         lfItalic As Byte
  29.         lfUnderline As Byte
  30.         lfStrikeOut As Byte
  31.         lfCharSet As Byte
  32.         lfOutPrecision As Byte
  33.         lfClipPrecision As Byte
  34.         lfQuality As Byte
  35.         lfPitchAndFamily As Byte
  36.         lfFaceName As String * 32
  37. End Type
  38. Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
  39. Public Const SPI_GETNONCLIENTMETRICS = 41
  40. Public Type NONCLIENTMETRICS
  41.     cbSize As Long
  42.     iBorderWidth As Long
  43.     iScrollWidth As Long
  44.     iScrollHeight As Long
  45.     iCaptionWidth As Long
  46.     iCaptionHeight As Long
  47.     lfCaptionFont As LOGFONT
  48.     iSMCaptionWidth As Long
  49.     iSMCaptionHeight As Long
  50.     lfSMCaptionFont As LOGFONT
  51.     iMenuWidth As Long
  52.     iMenuHeight As Long
  53.     lfMenuFont As LOGFONT
  54.     lfStatusFont As LOGFONT
  55.     lfMessageFont As LOGFONT
  56. End Type
  57. Dim CaptionFont As LOGFONT
  58. Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
  59. Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  60. Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  61. Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  62. Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  63. Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
  64. Public Declare Function GetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long) As Long
  65. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  66. Public Declare Function GetActiveWindow Lib "user32" () As Long
  67. Public Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  68. Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  69. Public Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  70. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  71. Public Const GWL_WNDPROC = (-4)
  72. Public Const GWL_STYLE = (-16)
  73. Public Const GCL_WNDPROC = (-24)
  74. Public Const GCL_HICON = (-14)
  75. Public Const WS_BORDER = &H800000
  76. Public Const WS_CAPTION = &HC00000
  77. Public Const WS_CHILD = &H40000000
  78. Public Const WS_CHILDWINDOW = (WS_CHILD)
  79. Public Const WS_CLIPCHILDREN = &H2000000
  80. Public Const WS_CLIPSIBLINGS = &H4000000
  81. Public Const WS_DISABLED = &H8000000
  82. Public Const WS_DLGFRAME = &H400000
  83. Public Const WS_EX_ACCEPTFILES = &H10&
  84. Public Const WS_EX_DLGMODALFRAME = &H1&
  85. Public Const WS_EX_NOPARENTNOTIFY = &H4&
  86. Public Const WS_EX_TOPMOST = &H8&
  87. Public Const WS_EX_TRANSPARENT = &H20&
  88. Public Const WS_GROUP = &H20000
  89. Public Const WS_HSCROLL = &H100000
  90. Public Const WS_MINIMIZE = &H20000000
  91. Public Const WS_ICONIC = WS_MINIMIZE
  92. Public Const WS_MAXIMIZE = &H1000000
  93. Public Const WS_MAXIMIZEBOX = &H10000
  94. Public Const WS_MINIMIZEBOX = &H20000
  95. Public Const WS_OVERLAPPED = &H0&
  96. Public Const WS_SYSMENU = &H80000
  97. Public Const WS_THICKFRAME = &H40000
  98. Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
  99. Public Const WS_POPUP = &H80000000
  100. Public Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
  101. Public Const WS_SIZEBOX = WS_THICKFRAME
  102. Public Const WS_TILED = WS_OVERLAPPED
  103. Public Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
  104. Public Const WS_VISIBLE = &H10000000
  105. Public Const WS_VSCROLL = &H200000
  106. Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  107. Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  108. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  109. Public Declare Function OffsetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  110. Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
  111. Public Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
  112. Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
  113. Public Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
  114. Public Declare Function RectInRegion Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long
  115. Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  116. Public Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long
  117. Public Const DT_SINGLELINE = &H20
  118. Public Const DT_VCENTER = &H4
  119. Public Const DT_END_ELLIPSIS = &H8000&
  120. Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  121. Public Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
  122. Public Declare Function GetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
  123. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  124. Public Declare Function DrawCaption Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long, pcRect As RECT, ByVal un As Long) As Long
  125. Public Declare Function ReleaseCapture Lib "user32" () As Long
  126. Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  127. Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  128. Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
  129. Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
  130. Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  131. Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  132. Public Const COLOR_ACTIVEBORDER = 10
  133. Public Const COLOR_ACTIVECAPTION = 2
  134. Public Const COLOR_ADJ_MAX = 100
  135. Public Const COLOR_ADJ_MIN = -100 'shorts
  136. Public Const COLOR_APPWORKSPACE = 12
  137. Public Const COLOR_BACKGROUND = 1
  138. Public Const COLOR_BTNFACE = 15
  139. Public Const COLOR_BTNHIGHLIGHT = 20
  140. Public Const COLOR_BTNSHADOW = 16
  141. Public Const COLOR_BTNTEXT = 18
  142. Public Const COLOR_CAPTIONTEXT = 9
  143. Public Const COLOR_GRAYTEXT = 17
  144. Public Const COLOR_HIGHLIGHT = 13
  145. Public Const COLOR_HIGHLIGHTTEXT = 14
  146. Public Const COLOR_INACTIVEBORDER = 11
  147. Public Const COLOR_INACTIVECAPTION = 3
  148. Public Const COLOR_INACTIVECAPTIONTEXT = 19
  149. Public Const COLOR_MENU = 4
  150. Public Const COLOR_MENUTEXT = 7
  151. Public Const COLOR_SCROLLBAR = 0
  152. Public Const COLOR_WINDOW = 5
  153. Public Const COLOR_WINDOWFRAME = 6
  154. Public Const COLOR_WINDOWTEXT = 8
  155. Public Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
  156. Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  157. Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  158. Public Const SM_CMETRICS = 44
  159. Public Const SM_CMOUSEBUTTONS = 43
  160. Public Const SM_CXBORDER = 5
  161. Public Const SM_CXCURSOR = 13
  162. Public Const SM_CXDLGFRAME = 7
  163. Public Const SM_CXDOUBLECLK = 36
  164. Public Const SM_CXFIXEDFRAME = SM_CXDLGFRAME
  165. Public Const SM_CXFRAME = 32
  166. Public Const SM_CXFULLSCREEN = 16
  167. Public Const SM_CXHSCROLL = 21
  168. Public Const SM_CXHTHUMB = 10
  169. Public Const SM_CXICON = 11
  170. Public Const SM_CXICONSPACING = 38
  171. Public Const SM_CXMIN = 28
  172. Public Const SM_CXMINTRACK = 34
  173. Public Const SM_CXSCREEN = 0
  174. Public Const SM_CXSMSIZE = 30
  175. Public Const SM_CXSIZEFRAME = SM_CXFRAME
  176. Public Const SM_CXVSCROLL = 2
  177. Public Const SM_CYBORDER = 6
  178. Public Const SM_CYCAPTION = 4
  179. Public Const SM_CYCURSOR = 14
  180. Public Const SM_CYDLGFRAME = 8
  181. Public Const SM_CYDOUBLECLK = 37
  182. Public Const SM_CYFIXEDFRAME = SM_CYDLGFRAME
  183. Public Const SM_CYFRAME = 33
  184. Public Const SM_CYFULLSCREEN = 17
  185. Public Const SM_CYHSCROLL = 3
  186. Public Const SM_CYICON = 12
  187. Public Const SM_CYICONSPACING = 39
  188. Public Const SM_CYKANJIWINDOW = 18
  189. Public Const SM_CYMENU = 15
  190. Public Const SM_CYMIN = 29
  191. Public Const SM_CYMINTRACK = 35
  192. Public Const SM_CYSCREEN = 1
  193. Public Const SM_CYSMSIZE = 31
  194. Public Const SM_CYSIZEFRAME = SM_CYFRAME
  195. Public Const SM_CYVSCROLL = 20
  196. Public Const SM_CYVTHUMB = 9
  197. Public Const SM_DBCSENABLED = 42
  198. Public Const SM_DEBUG = 22
  199. Public Const SM_MENUDROPALIGNMENT = 40
  200. Public Const SM_MOUSEPRESENT = 19
  201. Public Const SM_PENWINDOWS = 41
  202. Public Const SM_RESERVED1 = 24
  203. Public Const SM_RESERVED2 = 25
  204. Public Const SM_RESERVED3 = 26
  205. Public Const SM_RESERVED4 = 27
  206. Public Const SM_SWAPBUTTON = 23
  207. Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  208. Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  209. Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  210. Public Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
  211. Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  212. Public Declare Function ExcludeClipRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  213. Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  214. Public Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
  215. Public Const DFC_CAPTION = 1
  216. Public Const DFCS_CAPTIONRESTORE = &H3
  217. Public Const DFCS_CAPTIONMIN = &H1
  218. Public Const DFCS_CAPTIONMAX = &H2
  219. Public Const DFCS_CAPTIONHELP = &H4
  220. Public Const DFCS_CAPTIONCLOSE = &H0
  221. Public Const DFCS_INACTIVE = &H100
  222. Public Function GradientCallback(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  223. Dim OldBMP As Long, NewBMP As Long
  224. Dim rcWnd As RECT
  225. Select Case wMsg
  226. Case WM_NCACTIVATE, WM_MDIACTIVATE
  227.   GetWindowRect GradhWnd, rcWnd
  228.   GradientCallback = CallWindowProc(OldGradProc, hwnd, wMsg, wParam, lParam)
  229.   tmpDC = GetWindowDC(GradhWnd)
  230.   DrawDC = CreateCompatibleDC(tmpDC)
  231.   NewBMP = CreateCompatibleBitmap(tmpDC, rcWnd.Right - rcWnd.Left, 50)
  232.   OldBMP = SelectObject(DrawDC, NewBMP)
  233.   With rcWnd
  234.    hRgn = CreateRectRgn(.Left, .Top, .Right, .Bottom)
  235.    SelectClipRgn tmpDC, hRgn
  236.    OffsetClipRgn tmpDC, -.Left, -.Top
  237.   End With
  238.   If wParam And GetParent(GradhWnd) = 0 Then
  239.    DrawGradient 0, GetSysColor(COLOR_ACTIVECAPTION)
  240.   ElseIf wParam = GradhWnd And GetParent(GradhWnd) <> 0 Then
  241.    DrawGradient 0, GetSysColor(COLOR_INACTIVECAPTION)
  242.   ElseIf SendMessage(GetParent(GradhWnd), WM_MDIGETACTIVE, 0, 0) = GradhWnd Then
  243.    DrawGradient 0, GetSysColor(COLOR_ACTIVECAPTION)
  244.   Else
  245.    DrawGradient 0, GetSysColor(COLOR_INACTIVECAPTION)
  246.   End If
  247.   'Cleanup
  248.   SelectObject DrawDC, OldBMP
  249.   DeleteObject NewBMP
  250.   DeleteDC DrawDC
  251.   OffsetClipRgn tmpDC, rcWnd.Left, rcWnd.Top
  252.   GetClipRgn tmpDC, hRgn
  253.   ReleaseDC GradhWnd, tmpDC
  254.   DeleteObject hRgn
  255.   tmpDC = 0
  256.   Exit Function
  257. Case WM_NCPAINT
  258.   GetWindowRect GradhWnd, rcWnd
  259.   tmpDC = GetWindowDC(GradhWnd)
  260.   DrawDC = CreateCompatibleDC(tmpDC)
  261.   NewBMP = CreateCompatibleBitmap(tmpDC, rcWnd.Right - rcWnd.Left, 50)
  262.   OldBMP = SelectObject(DrawDC, NewBMP)
  263.   With rcWnd
  264.    hRgn = CreateRectRgn(.Left, .Top, .Right, .Bottom)
  265.    SelectClipRgn tmpDC, hRgn
  266.    OffsetClipRgn tmpDC, -.Left, -.Top
  267.   End With
  268.   If GetActiveWindow() = GradhWnd Then
  269.    DrawGradient 0, GetSysColor(COLOR_ACTIVECAPTION)
  270.   ElseIf SendMessage(GetParent(GradhWnd), WM_MDIGETACTIVE, 0, 0) = GradhWnd Then
  271.    DrawGradient 0, GetSysColor(COLOR_ACTIVECAPTION)
  272.   Else
  273.    DrawGradient 0, GetSysColor(COLOR_INACTIVECAPTION)
  274.   End If
  275.   SelectObject DrawDC, OldBMP
  276.   DeleteObject NewBMP
  277.   DeleteDC DrawDC
  278.   OffsetClipRgn tmpDC, rcWnd.Left, rcWnd.Top
  279.   GetClipRgn tmpDC, hRgn
  280.   GradientCallback = CallWindowProc(OldGradProc, hwnd, WM_NCPAINT, hRgn, lParam)
  281.   ReleaseDC GradhWnd, tmpDC
  282.   DeleteObject hRgn
  283.   tmpDC = 0
  284.   Exit Function
  285. Case WM_SIZE
  286.   If hwnd = GradhWnd Then SendMessage GradhWnd, WM_NCPAINT, 0, 0
  287. End Select
  288. GradientCallback = CallWindowProc(OldGradProc, hwnd, wMsg, wParam, lParam)
  289. End Function
  290. Public Sub GradientForm(frm As Form)
  291. If OldGradProc <> 0 Then Exit Sub
  292. GradhWnd = frm.hwnd
  293. GradIcon = frm.Icon
  294. OldGradProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf GradientCallback)
  295. GradientGetCapsFont
  296. End Sub
  297. Public Sub GradientReleaseForm()
  298. If OldGradProc = 0 Or GradhWnd = 0 Then Exit Sub
  299. SetWindowLong GradhWnd, GWL_WNDPROC, OldGradProc
  300. OldGradProc = 0
  301. GradhWnd = 0
  302. End Sub
  303. Private Function DrawGradient(ByVal Color1 As Long, ByVal Color2 As Long) As Long
  304. Dim i As Integer
  305. Dim DestWidth As Long, DestHeight As Long
  306. Dim StartPnt As Integer, EndPnt As Integer
  307. Dim PixelStep As Long, XBorder As Long
  308. Dim WndRect As RECT
  309. Dim OldFont As Long
  310. Dim fText As String
  311. On Error Resume Next
  312. GetWindowRect GradhWnd, WndRect
  313. With WndRect
  314.  DestWidth = .Right - .Left
  315. End With
  316. DestHeight = GetSystemMetrics(SM_CYCAPTION)
  317. fText = Space$(255)
  318. Call GetWindowText(GradhWnd, fText, 255)
  319. fText = Trim$(fText)
  320. XBorder = GetSystemMetrics(SM_CXDLGFRAME)
  321. DestWidth = DestWidth - (XBorder * 2) - (GetSystemMetrics(SM_CXSMSIZE) * 3) + 6
  322. StartPnt = XBorder
  323. EndPnt = XBorder + DestWidth - 4
  324. PixelStep = DestWidth \ 8
  325. ReDim Colors(PixelStep) As Long
  326. GradateColors Colors(), Color1, Color2
  327. Dim rct As RECT
  328. Dim hBr As Long
  329. With rct
  330.  .Top = XBorder
  331.  .Left = XBorder
  332.  .Right = XBorder + (DestWidth \ PixelStep)
  333.  .Bottom = XBorder + DestHeight - 1
  334. For i = 0 To PixelStep - 1
  335.  hBr = CreateSolidBrush(Colors(i))
  336.  FillRect DrawDC, rct, hBr
  337.  DeleteObject hBr
  338.  OffsetRect rct, (DestWidth \ PixelStep), 0
  339.  If i = PixelStep - 2 Then .Right = EndPnt
  340. Next
  341. If GradIcon <> 0 Then
  342.  .Left = XBorder + GetSystemMetrics(SM_CXSMSIZE) + 2
  343.  DrawIconEx DrawDC, XBorder + 1, XBorder + 1, GradIcon, GetSystemMetrics(SM_CXSMSIZE) - 2, GetSystemMetrics(SM_CYSMSIZE) - 2, ByVal 0&, ByVal 0&, 2
  344. Else
  345.  .Left = XBorder
  346. End If
  347. If CaptionFont.lfHeight = 0 And tmpGradFont = 0 Then
  348.  tmpGradFont = SendMessage(GradhWnd, WM_GETFONT, 0, 0)
  349. ElseIf tmpGradFont = 0 Then
  350.  tmpGradFont = CreateFontIndirect(CaptionFont)
  351. End If
  352. OldFont = SelectObject(DrawDC, tmpGradFont)
  353. SetBkMode DrawDC, 1
  354. SetTextColor DrawDC, RGB(255, 255, 255)
  355. .Left = .Left + 2
  356. .Right = .Right - 10
  357. DrawText DrawDC, fText, Len(fText) - 1, rct, DT_SINGLELINE Or DT_END_ELLIPSIS Or DT_VCENTER
  358. SelectObject DrawDC, OldFont
  359. DeleteObject tmpGradFont
  360. tmpGradFont = 0
  361. .Left = XBorder
  362. .Right = .Right + 12
  363. If tmpDC <> 0 Then
  364.  BitBlt tmpDC, .Left, .Top, .Right - .Left - 10, .Bottom - .Top, DrawDC, .Left, .Top, vbSrcCopy
  365.  ExcludeClipRect tmpDC, XBorder, XBorder, .Right - .Left - 8, .Bottom - .Top + 4
  366. End If
  367. End With
  368. End Function
  369. Private Sub GradateColors(Colors() As Long, ByVal Color1 As Long, ByVal Color2 As Long)
  370. Dim i As Integer
  371. Dim dblR As Double, dblG As Double, dblB As Double
  372. Dim addR As Double, addG As Double, addB As Double
  373. Dim bckR As Double, bckG As Double, bckB As Double
  374. dblR = CDbl(Color1 And &HFF)
  375. dblG = CDbl(Color1 And &HFF00&) / 255
  376. dblB = CDbl(Color1 And &HFF0000) / &HFF00&
  377. bckR = CDbl(Color2 And &HFF&)
  378. bckG = CDbl(Color2 And &HFF00&) / 255
  379. bckB = CDbl(Color2 And &HFF0000) / &HFF00&
  380. addR = (bckR - dblR) / UBound(Colors)
  381. addG = (bckG - dblG) / UBound(Colors)
  382. addB = (bckB - dblB) / UBound(Colors)
  383. For i = 0 To UBound(Colors)
  384.  dblR = dblR + addR
  385.  dblG = dblG + addG
  386.  dblB = dblB + addB
  387.  If dblR > 255 Then dblR = 255
  388.  If dblG > 255 Then dblG = 255
  389.  If dblB > 255 Then dblB = 255
  390.  If dblR < 0 Then dblR = 0
  391.  If dblG < 0 Then dblG = 0
  392.  If dblG < 0 Then dblB = 0
  393.  Colors(i) = RGB(dblR, dblG, dblB)
  394. Next
  395. End Sub
  396. Public Sub GradientGetCapsFont()
  397. Dim NCM As NONCLIENTMETRICS
  398. Dim lfNew As LOGFONT
  399. NCM.cbSize = Len(NCM)
  400. Call SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, NCM, 0)
  401. If NCM.iCaptionHeight = 0 Then
  402.  CaptionFont.lfHeight = 0
  403. Else
  404.  CaptionFont = NCM.lfSMCaptionFont
  405. End If
  406. End Sub
  407.