VB6之阴影图层

要是能创建半透明的刷子就好了，就不必像这样以图层的方式实现透明阴影效果。

代码：

 'code by lichmama@cnblogs.com
 '绘制阴影图层
 Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, _
     ByVal nHeight As Long) As Long
 Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
 Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
 Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, _
     ByVal X1 As Long, _
     ByVal Y1 As Long, _
     ByVal X2 As Long, _
     ByVal Y2 As Long) As Long
 Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, _
     ByVal nWidth As Long, _
     ByVal crColor As Long) As Long
 Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, _
     ByVal tx As Long, _
     ByVal ty As Long, _
     ByVal Tw As Long, _
     ByVal Th As Long, _
     ByVal hdc As Long, _
     ByVal sx As Long, _
     ByVal sy As Long, _
     ByVal sw As Long, _
     ByVal sh As Long, _
     ByVal BLENDFUNCT As Long) As Long
 Private Const PS_SOLID = 

 Private Sub Command1_Click()
     Dim hMemdc As Long
     Dim hBmp As Long
     Dim hBrush As Long
     Dim hPen As Long
     Dim w As Long
     Dim h As Long

     w = &
     h = &

     hMemdc = CreateCompatibleDC(&)
     hBmp = CreateCompatibleBitmap(Me.hdc, w, h)
     Call SelectObject(hMemdc, hBmp)

     hBrush = CreateSolidBrush(RGB(, , ))
     Call SelectObject(hMemdc, hBrush)

     hPen = CreatePen(PS_SOLID, &, RGB(, , ))
     Call SelectObject(hMemdc, hPen)

     Call Rectangle(hMemdc, &, &, w, h)
     Call AlphaBlend(Picture2.hdc, &, &, w, h, hMemdc, &, &, w, h, &H10000 * )

     Call DeleteObject(hBrush)
     Call DeleteObject(hPen)
     Call DeleteObject(hBmp)
     Call DeleteObject(hMemdc)
 End Sub

贴张图：