● カーソルを変更する ●

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 Const OCR_IBEAM = 32513
Private Const OCR_WAIT = 32514
Private Const OCR_CROSS = 32515
Private Const OCR_UP = 32516
Private Const OCR_SIZE = 32640
Private Const OCR_ICON = 32641
Private Const OCR_SIZENWSE = 32642
Private Const OCR_SIZENESW = 32643
Private Const OCR_SIZEWE = 32644
Private Const OCR_SIZENS = 32645
Private Const OCR_SIZEALL = 32646
Private Const OCR_ICOCUR = 32647
Private Const OCR_NO = 32648

Private hCursor As Long
Private hDefaultCursor 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

戻る