Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetClientRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" _
(ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32" _
(ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetRect Lib "user32" _
(lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Function SafeDiv(X1 As Double, X2 As Double) As Double
If X2 = 0 Then SafeDiv = 0 Else SafeDiv = X1 / X2
End Function
Private Sub PaintGradient(frm As Form, Red1 As Integer, Green1 As Integer, Blue1 As Integer, _
Red2 As Integer, Green2 As Integer, Blue2 As Integer)
Dim WinRect As RECT
Dim ColorRect As RECT
Dim Y As Long
Dim hBrush As Long
Dim hPrevBrush As Long
Dim DivValue As Double
Dim CurrRed As Integer
Dim CurrGreen As Integer
Dim CurrBlue As Integer
GetClientRect frm.hwnd, WinRect
For Y = WinRect.Top To WinRect.Bottom
DivValue = SafeDiv((WinRect.Bottom - WinRect.Top), (Y - WinRect.Top))
CurrRed = Red1 + SafeDiv((Red2 - Red1), DivValue)
CurrGreen = Green1 + SafeDiv((Green2 - Green1), DivValue)
CurrBlue = Blue1 + SafeDiv((Blue2 - Blue1), DivValue)
SetRect ColorRect, WinRect.Left, Y, WinRect.Right, Y + 1
hBrush = CreateSolidBrush(RGB(CurrRed, CurrGreen, CurrBlue))
hPrevBrush = SelectObject(frm.hdc, hBrush)
FillRect frm.hdc, ColorRect, hBrush
SelectObject frm.hdc, hPrevBrush
DeleteObject hBrush
Next
End Sub
Private Sub Form_Paint()
PaintGradient Me, 255, 128, 0, 128, 0, 255
End Sub
|
