マウスカーソル位置(スクリーン座標)の取得             <TOP>


マウスカーソルのスクリーン座標を一定時間毎に取得し表示します。ついでにマウスの移動範囲をフォーム上に限定してみます。

GetCursorPos スクリーン座標取得関数

ClipCursor マウスの移動範囲を限定


TimerとButtonを貼り付けます。

初期状態および「ScreenPos」をクリックした場合

マウスカーソルがフォーム外にある場合は、スクリーン座標のみ表示

「ClipPos」をクリックした場合マウスの移動範囲はフォーム上に限定されます。

マウスカーソルがフォーム内にある場合(フォーム内の座標/スクリーン座標)

 

'================================================================
'= スクリーン上のマウスカーソルの位置を取得
'=   (GetCursorPos.bas)
'================================================================
#include "Windows.bi"

Type POINTAPI
    X As Long
    Y As Long
End Type

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

' マウスカーソル(マウスポインタ)の現在の位置に相当するスクリーン座標を取得
Declare Function Api_GetCursorPos& Lib "user32" Alias "GetCursorPos" (pa As POINTAPI)

' マウスの移動範囲を制限
Declare Function Api_ClipCursor& Lib "user32" Alias "ClipCursor" (lpRect As Any)

Var Shared Text(3) As Object
Var Shared Button(1) As Object
Var Shared Timer1 As Object
Var Shared Group1 As Object

For i = 0 To 3
    If i < 2 Then
        Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1)))
        Button(i).SetFontSize 14
    End If
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1)))
    Text(i).SetFontSize 14
Next i

Timer1.Attach GetDlgItem("Timer1")
Group1.Attach GetDlgItem("Group1") : Group1.SetFontSize 14

Var Shared rc As RECT

'================================================================
'= 
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Timer1.SetInterval 10
    Timer1.Enable -1

    ShowWindow -1
End Sub

'================================================================
'= 
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Var pa As POINTAPI
    Var Ret As Long

    rc.Left = GetLeft
    rc.Top = GetTop
    rc.Right = rc.Left + GetWidth 
    rc.Bottom = rc.Top + GetHeight 

    Ret = Api_GetCursorPos(pa)

    If pa.X - rc.Left < 0 Or pa.Y - rc.Top < 0 Or pa.X > rc.Right Or pa.Y > rc.Bottom Then
        Text(0).SetWindowText Format$(pa.X, "#,###")
        Text(1).SetWindowText Format$(pa.Y, "#,###")
    Else
        Text(0).SetWindowText Format$(pa.X - rc.Left, "#,###") & " /" & format$(pa.X, "#,###")
        Text(1).SetWindowText Format$(pa.Y - rc.Top , "#,###") & " /" & format$(pa.Y, "#,###")
    End If
End Sub

'================================================================
'= スクリーン座標
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Ret As Long

    Ret = Api_ClipCursor(ByVal 0)
    SetWindowText "GetCursorPos"
End Sub

'================================================================
'= フォーム上の座標に限定
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var Ret As Long

    Ret = Api_ClipCursor(rc)
    SetWindowText "ClipCursor"
End Sub

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