Screen.MousePointer で指定することが出来ない独自のカーソルを設定したいときにどうぞ。
[注意] カーソルを変更したら必ず元に戻すこと!! Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Boolean Private Declare Function CopyCursor Lib "user32" Alias "CopyIcon" (ByVal hcur As Long) As Long Private Declare Function GetCursor Lib "user32" () As Long Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Const OCR_NORMAL = 32512
Private hCursor As Long
'----------------------------------------------------------------------- ' 関数名 : ChangeCursor ' 機 能 : カーソルを変更する ' 引 数 : (in) CursorName … カーソル名 ' 戻り値 : カーソルのハンドル ' 備 考 : アニメーションカーソルもへっちゃら '----------------------------------------------------------------------- Public Function ChangeCursor(ByVal CursorName As String) As Long 'ハンドルが設定されている場合は終了(複数設定禁止) If hCursor Then Exit Function 'カーソルをロード hCursor = LoadCursorFromFile(CursorName) 'カーソルのハンドルを取得できた場合 If hCursor Then 'カーソル戻し用に現在のカーソルをコピーしておく hDefaultCursor = CopyCursor(GetCursor()) 'カーソル設定 Call SetSystemCursor(hCursor, OCR_NORMAL) End If ChangeCursor = hCursor End Function '----------------------------------------------------------------------- ' 関数名 : ReturnCursor ' 機 能 : カーソルを元に戻す ' 引 数 : なし ' 戻り値 : なし ' 備 考 : 必ず元に戻すこと、そうしないと変更されたままになっちゃうよ!! '----------------------------------------------------------------------- Public Sub ReturnCursor() If hCursor Then 'カーソルを元に戻す Call SetSystemCursor(hDefaultCursor, OCR_NORMAL) hCursor = 0 End If End Sub |