Option Explicit

Private Declare Function DrawIcon Lib "user32" ( _
    ByVal hdc As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal hIcon As Long _
) As Long
Private Declare Function DrawIconEx Lib "user32" ( _
    ByVal hdc As Long, _
    ByVal xLeft As Long, _
    ByVal yTop As Long, _
    ByVal hIcon As Long, _
    ByVal cxWidth As Long, _
    ByVal cyWidth As Long, _
    ByVal istepIfAniCur As Long, _
    ByVal hbrFlickerFreeDraw As Long, _
    ByVal diFlags As Long _
) As Long
Private Declare Sub Sleep Lib "kernel32" ( _
    ByVal dwMilliseconds As Long _
)
Private Declare Function LoadImageByLong Lib "user32" Alias "LoadImageA" ( _
    ByVal hInst As Long, _
    ByVal lpsz As Long, _
    ByVal un1 As Long, _
    ByVal n1 As Long, _
    ByVal n2 As Long, _
    ByVal un2 As Long _
) As Long
Private Declare Function DestroyCursor Lib "user32" ( _
    ByVal hCursor As Long _
) As Long
Private Declare Function SendMessageByLong Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long _
) As Long
Private Declare Function CreateWindowExByLong Lib "user32" Alias "CreateWindowExA" ( _
    ByVal dwExStyle As Long, _
    ByVal lpClassName As String, _
    ByVal lpWindowName As Long, _
    ByVal dwStyle As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hWndParent As Long, _
    ByVal hMenu As Long, _
    ByVal hInstance As Long, _
    lpParam As Any _
) As Long
Private Declare Function DestroyWindow Lib "user32" ( _
    ByVal hWnd As Long _
) As Long

Private Const OCR_NORMAL = 32512&
Private Const OCR_WAIT = 32514&
Private Const LR_DEFAULTSIZE = &H40&
Private Const LR_SHARED = &H8000&
Private Const IMAGE_CURSOR = 2
Private Const STM_SETIMAGE = &H172&
Private Const DI_DEFAULTSIZE = &H8&
Private Const DI_NORMAL = &H3&
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const SS_ICON = &H3&

Private hWndCur As Long
Private hCur As Long

Private Sub Command1_Click()
    Dim I As Long
    
    'Call DrawIcon(Picture1.hdc, 0, 0, hCur)   ' <- Win98で思ったカーソルが描画できない
    
    ' 手動でアニメーションカーソルを描画
    I = 0
    While 0 <> DrawIconEx(Picture1.hdc, 0, 0, hCur, 0, 0, I, 0, DI_DEFAULTSIZE Or DI_NORMAL)
        I = I + 1
        DoEvents
        Call Sleep(100)
        Picture1.Cls
    Wend
    Call DrawIconEx(Picture1.hdc, 0, 0, hCur, 0, 0, 0, 0, DI_DEFAULTSIZE Or DI_NORMAL)
End Sub

Private Sub Form_Load()
    ' 処理中のシステムカーソルを取得(アニメーションカーソル)
    hCur = LoadImageByLong(ByVal 0, OCR_WAIT, IMAGE_CURSOR, 0, 0, LR_SHARED Or LR_DEFAULTSIZE)
    ' カーソルハンドルをキャプションに表示
    Me.Caption = "Cursor Handle : &H" & Hex$(hCur)
    
    ' アニメーションカーソル再生用ウィンドウを作成
    hWndCur = CreateWindowExByLong(0, "Static", ByVal 0, WS_CHILD Or WS_VISIBLE Or SS_ICON, 0, 0, 32, 32, Picture2.hWnd, ByVal 0, App.hInstance, ByVal 0)
    ' ウィンドウにカーソルをセット
    Call SendMessageByLong(hWndCur, STM_SETIMAGE, IMAGE_CURSOR, hCur)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' アニメーションカーソル再生用ウィンドウを破棄
    Call DestroyWindow(hWndCur)
End Sub