'================================================================
'= アイコンをカーソルに

'=    (IconToCursor.bas)
'================================================================
#include "Windows.bi"

' カーソルのコピーを作成する
Declare Function Api_CopyCursor& Lib "user32" Alias "CopyIcon" (ByVal pcur&)

' 画像ファイルの読み込み
Declare Function Api_LoadImage& Lib "user32" Alias "LoadImageA" (ByVal hInst&, ByVal lpszName$, ByVal uType&, ByVal cxDesired&, ByVal cyDesired&, ByVal fuLoad&)

' マウスカーソルを設定する
Declare Function Api_SetCursor& Lib "user32" Alias "SetCursor" (ByVal hCursor&)

' カーソルを破棄する
Declare Function Api_DestroyCursor& Lib "user32" Alias "DestroyCursor" (ByVal hCursor&)

' アイコンのハンドルを破棄する
Declare Function Api_DestroyIcon& Lib "user32" Alias "DestroyIcon" (ByVal hIcon&)

#define LR_LOADFROMFILE &H10            '外部ファイルからロードする
#define IMAGE_BITMAP 0                  'ビットマップ
#define IMAGE_CURSOR 2                  'カーソル
#define IMAGE_ENHMETAFILE 3             '拡張メタファイル
#define IMAGE_ICON 1                    'アイコン

Var Shared hCursor As Long
Var Shared hOldCursor As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var hIcon As Long
    Var Ret As Long

    'アイコンファイルからカーソルを作る
    hIcon = Api_LoadImage(GethInst, "Pencil.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)

    '読み込んだアイコンをカーソルとしてコピー
    hCursor = Api_CopyCursor(hIcon)

    '元のカーソルを記憶
    hOldCursor = Api_SetCursor(hCursor)
    Ret = Api_DestroyIcon(hIcon)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_MouseMove edecl(ByVal Button%, ByVal Shift%, ByVal SX!, ByVal SY!)
Sub MainForm_MouseMove(ByVal Button%, ByVal Shift%, ByVal SX!, ByVal SY!)
    Var Ret As Long

    'カーソルが移動するたびに元の形状に戻ろうとするので再設定する
    Ret = Api_SetCursor(hCursor)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    '元のカーソルに戻す
    Ret = Api_SetCursor(hOldCursor)
    Ret = Api_DestroyCursor(hCursor)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End