vb6:用渐变填充多边形
答
下面的代码将绘制渐变填充矩形。我从vbcity.com的this thread稍微修改了一下。
跌落到这一个模块:
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Sub gdiDrawGradient(_
ByVal hdc As Long, _
ByRef rct As RECT, _
ByVal lEndColor As Long, _
ByVal lStartColor As Long, _
ByVal bVertical As Boolean)
Dim lStep As Long
Dim lPos As Long, lSize As Long
Dim bRGB(1 To 3) As Integer
Dim bRGBStart(1 To 3) As Integer
Dim dR(1 To 3) As Double
Dim dPos As Double, d As Double
Dim hBr As Long
Dim tR As RECT
LSet tR = rct
If bVertical Then
lSize = (tR.Bottom - tR.Top)
Else
lSize = (tR.Right - tR.Left)
End If
lStep = lSize \ 255
If (lStep < 3) Then
lStep = 3
End If
bRGB(1) = lStartColor And &HFF&
bRGB(2) = (lStartColor And &HFF00&) \ &H100&
bRGB(3) = (lStartColor And &HFF0000) \ &H10000
bRGBStart(1) = bRGB(1): bRGBStart(2) = bRGB(2): bRGBStart(3) = bRGB(3)
dR(1) = (lEndColor And &HFF&) - bRGB(1)
dR(2) = ((lEndColor And &HFF00&) \ &H100&) - bRGB(2)
dR(3) = ((lEndColor And &HFF0000) \ &H10000) - bRGB(3)
For lPos = lSize To 0 Step -lStep '
' Draw bar
If bVertical Then
tR.Top = tR.Bottom - lStep
Else
tR.Left = tR.Right - lStep
End If
If tR.Top < rct.Top Then
tR.Top = rct.Top
End If
If tR.Left < rct.Left Then
tR.Left = rct.Left
End If
hBr = CreateSolidBrush((bRGB(3) * &H10000 + bRGB(2) * &H100& + bRGB(1)))
FillRect hdc, tR, hBr
DeleteObject hBr
' Adjust colour '
dPos = ((lSize - lPos)/lSize)
If bVertical Then
tR.Bottom = tR.Top
bRGB(1) = bRGBStart(1) + dR(1) * dPos
bRGB(2) = bRGBStart(2) + dR(2) * dPos
bRGB(3) = bRGBStart(3) + dR(3) * dPos
Else
tR.Right = tR.Left
bRGB(1) = bRGBStart(1) + dR(1) * dPos
bRGB(2) = bRGBStart(2) + dR(2) * dPos
bRGB(3) = bRGBStart(3) + dR(3) * dPos
End If
Next lPos
End Sub
要进行测试,该代码添加到窗体:
Private Sub Command1_Click()
Dim r As RECT
r.Left = 10
r.Top = 10
r.Right = 100
r.Bottom = 150
Call gdiDrawGradient(Me.hdc, r, vbRed, vbBlue, True)
End Sub
答
- 这里的how to fill any polygon with a gradient,使用从VB6的Windows API调用。
- 这是how to fill a PictureBox with a gradient,纯VB6没有API调用。