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 |