Snippet Library

Private 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
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const SRCAND = &H8800C6
Private Const SRCCOPY = &HCC0020

Private Sub Command1_Click()
    Dim lDC As Long
    Dim lBMP As Long
    Dim W As Integer
    Dim H As Integer
    Dim lColor As Long

    W = ScaleX(Picture1.Picture.Width, vbHimetric, vbPixels)
    H = ScaleY(Picture1.Picture.Height, vbHimetric, vbPixels)
    lBMP = CreateCompatibleBitmap(Picture1.hdc, W, H)
    lDC = CreateCompatibleDC(Picture1.hdc)
    Call SelectObject(lDC, lBMP)
    BitBlt lDC, 0, 0, W, H, Picture1.hdc, 0, 0, SRCCOPY
    Picture1 = LoadPicture("")
    For lColor = 255 To 0 step -3
        Picture1.BackColor = RGB(lColor, lColor, lColor)
        BitBlt Picture1.hdc, 0, 0, W, H, lDC, 0, 0, SRCAND
        Sleep 10
    Next
    Call DeleteDC(lDC)
    Call DeleteObject(lBMP)
End Sub
;