vb6：用漸變填充多邊形

Question

任何人都可以告訴我，如果可以用vb6下的漸變填充多邊形嗎？

THX

Answer 1

下面的代碼將繪製漸變填充矩形。我從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 

Answer 2

• 這裏的how to fill any polygon with a gradient，使用從VB6的Windows API調用。
• 這是how to fill a PictureBox with a gradient，純VB6沒有API調用。