Контрол с прозрачностью и hwnd, hdc?

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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
 
Private Const AB_32Bpp255 = 33488896
 
Dim Img As StdPicture, DC As Long, oBmp As Long
 
Private Sub cmdFrame_Click()
    Static Frame As Long
    
    ClearBackground pic.hwnd
    
    oBmp = SelectObject(DC, Img.Handle)
    AlphaBlend pic.hdc, 0, 0, 128, 128, DC, 0, Frame * 128, 128, 128, AB_32Bpp255
    SelectObject DC, oBmp
    
    pic.Refresh
    
    Frame = (Frame + 1) Mod 21
End Sub
 
Private Sub Form_Load()
    MakeTransparent pic
    DC = CreateCompatibleDC(pic.hdc)
    Set Img = LoadPicture(App.Path & "\seq.bmp")
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    RemoveTransparent pic
    DeleteDC DC
End Sub

Option Explicit
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Type POINTAPI
  x As Long
  y As Long
End Type
Public Type PAINTSTRUCT
  hdc As Long
  fErase As Long
  rcPaint As RECT
  fRestore As Long
  fIncUpdate As Long
  rgbReserved(31) As Byte
End Type
 
Private Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function MapWindowPoints Lib "user32" (ByVal hwndFrom As Long, ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
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 GetMem4 Lib "msvbvm60" (pSrc As Any, pDst As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
 
Private Const GWL_WNDPROC = &HFFFFFFFC
Private Const WM_PAINT = &HF
Private Const RDW_UPDATENOW = &H100&  ' Causes the affected windows to receive WM_NCPAINT, WM_ERASEBKGND, and WM_PAINT messages
Private Const RDW_INVALIDATE = &H1
Private Const RDW_NOCHILDREN = &H40
Private Const AB_32Bpp255 = 33488896
 
Public Sub MakeTransparent(Control As Object)
    Dim Prev As Long, hwnd As Long
    
    hwnd = Control.hwnd
    Prev = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
    SetProp hwnd, "prev", Prev
    SetProp hwnd, "ptr", ObjPtr(Control)
End Sub
Public Sub RemoveTransparent(Control As Object)
    Dim Prev As Long, hwnd As Long
    
    hwnd = Control.hwnd
    Prev = GetProp(hwnd, "prev")
    SetWindowLong hwnd, GWL_WNDPROC, Prev
    RemoveProp hwnd, "prev"
    RemoveProp hwnd, "ptr"
End Sub
 
Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Prev As Long
    Dim ps As PAINTSTRUCT
    Select Case uMsg
    Case WM_PAINT
        BeginPaint hwnd, ps
        Paint hwnd, ps
        EndPaint hwnd, ps
        WndProc = 0
    Case Else
        Prev = GetProp(hwnd, "prev")
        WndProc = CallWindowProc(Prev, hwnd, uMsg, wParam, lParam)
    End Select
End Function
Public Sub ClearBackground(hwnd As Long)
    Dim Ptr As Long, Obj As Object, dDc As Long, sDc As Long, rc As RECT, pWnd As Long, Pt As POINTAPI
    On Error Resume Next
    Ptr = GetProp(hwnd, "ptr")
    If Ptr Then
        GetMem4 Ptr, Obj
        dDc = Obj.hdc: sDc = GetDC(hwnd)
        pWnd = GetParent(hwnd)
        GetClientRect hwnd, rc
        MapWindowPoints hwnd, pWnd, Pt, 1
        rc.Left = Pt.x: rc.Top = Pt.y: rc.Right = rc.Left + rc.Right: rc.Bottom = rc.Top + rc.Bottom
        RedrawWindow pWnd, rc, 0, RDW_UPDATENOW Or RDW_NOCHILDREN Or RDW_INVALIDATE
        BitBlt dDc, 0, 0, rc.Right, rc.Bottom, sDc, 0, 0, vbSrcCopy
        ReleaseDC hwnd, sDc
        GetMem4 0, Obj
    End If
End Sub
Private Sub Paint(hwnd As Long, ps As PAINTSTRUCT)
    Dim DC As Long, Ptr As Long, Obj As Object
    On Error Resume Next
    Ptr = GetProp(hwnd, "ptr")
    If Ptr Then
        GetMem4 Ptr, Obj
        DC = Obj.hdc
        BitBlt ps.hdc, ps.rcPaint.Left, ps.rcPaint.Top, _
                   ps.rcPaint.Right - ps.rcPaint.Left, _
                   ps.rcPaint.Bottom - ps.rcPaint.Top, _
                   DC, ps.rcPaint.Left, ps.rcPaint.Top, vbSrcCopy
        GetMem4 0, Obj
    End If
 
End Sub

Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Prev As Long
 
    Select Case uMsg
    Case WM_PAINT 
'1.................
        Dim pWnd As Long, Pt As POINTAPI, RC As RECT
        
        pWnd = GetParent(hwnd)
        GetClientRect hwnd, RC
        
        MapWindowPoints hwnd, pWnd, Pt, 1
        RC.Left = Pt.x: RC.Top = Pt.y: RC.Right = RC.Left + RC.Right: RC.Bottom = RC.Top + RC.Bottom
        RedrawWindow pWnd, RC, 0, RDW_UPDATENOW Or RDW_NOCHILDREN Or RDW_INVALIDATE
 
        ValidateRect hwnd, ByVal 0
' end 1........................
    Case Else
        Prev = GetProp(hwnd, "prev")
        WndProc = CallWindowProc(Prev, hwnd, uMsg, wParam, lParam)
    End Select
End Function