マウスカーソルの変更          <TOP>

ここでは、マウスカーソルをアニメーション形式に変更してみます。

GetWindowsDirectory Winodws フォルダのパス名を取得

CopyIcon カーソルのコピーを作成

LoadCursorFromFile カーソルをファイルから取得

SetSystemCursor システムのマウスカーソルを変更

GetCursor 現在使用しているマウスカーソルのハンドルを取得

　

カーソルは『コントロールパネル』→『マウス』→『ポインタ』→『参照』で見ることができます。

　

'================================================================
'= マウスカーソルの変更
'=    (SetCursor.bas)
'================================================================
#include "Windows.bi"

' Windowsディレクトリのパス名を取得
Declare Function Api_GetWindowsDirectory& Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer$, ByVal nSize&)

' カーソルのコピーを作成
Declare Function Api_CopyIcon& Lib "user32" Alias "CopyIcon" (ByVal hIcon&)

' カーソルをファイルから取得
Declare Function Api_LoadCursorFromFile& Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName$)

' システムのマウスカーソルを変更
Declare Function Api_SetSystemCursor& Lib "user32" Alias "SetSystemCursor" (ByVal hcur&, ByVal id&)

' 現在使用しているマウスカーソルのハンドルを取得
Declare Function Api_GetCursor& Lib "user32" Alias "GetCursor" ()

#define OCR_NORMAL 32512                'Windows組込ビットマップ

Var Shared CurrenthCurs As Long
Var Shared TempCurs As Long
Var Shared NewhCurs As Long

Var Shared Button1 As Object
Var Shared Button2 As Object

Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Button2.Attach GetDlgItem("Button2") : Button2.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var myDir As String
    Var lDir As Long
    Var Ret As Long

    myDir = Space$(255)

    '現在のカーソルを取得しコピーを作成
    CurrenthCurs = Api_GetCursor()
    TempCurs = Api_CopyIcon(CurrenthCurs)

    'Windowsディレクトリのパス名を取得
    lDir = Api_GetWindowsDirectory(myDir, 255)

    'Horse.aniまでのパスを取得
    myDir = Left$(myDir, lDir) & "\cursors\horse.ani"

    'カーソルをファイルから取得
    NewhCurs = Api_LoadCursorFromFile(myDir)

    'システムのマウスカーソルを変更
    Ret = Api_SetSystemCursor(NewhCurs, OCR_NORMAL)
End Sub

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

    'システムカーソルを元に戻す
    Ret = Api_SetSystemCursor(TempCurs, OCR_NORMAL)
End Sub

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