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


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

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

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

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

SetCursor マウスカーソルの形状を設定

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_SetCursor& Lib "user32" Alias "SetCursor" (ByVal hCursor&)

' システムのマウスカーソルを変更
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

'================================================================
'=
'================================================================
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)
    lDir = Api_GetWindowsDirectory(myDir, 255)
    myDir = Left$(myDir, lDir) & "\cursors\iwatobi3.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