#564 マウスポインタの位置を取得・設定するには? VBA、API

フォーム上でマウスポインタの位置を取得するには、ひとつの方法として、セクションやコントロールの「MouseMove/マウスボタン移動時」イベントを利用する方法があります。

たとえば次のようなコードを書きます。

Private Sub 詳細_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'詳細セクションのマウスボタン移動時

  'マウスのポインタの位置をテキストボックスに表示
  Me!txtX = x
  Me!txtY = y

End Sub


マウスのポインタの位置をテキストボックスに表示

ただしこの方法には2つ問題があります。
  • セクションやコントロールなどの左上端を基点とした座標値しか取得できない
  • ポインタの位置を設定することができない(引数X・Yに値を代入しても反映されません)

そこで、Windows APIを使って、ディスプレイ全体に対する座標値(スクリーン座標)を取得するとともに、ポインタの位置を強制的に設定する方法です。

次の例では、詳細セクション上をマウスが移動すると、その座標値がテキストボックスに表示されます。また[移動]ボタン(cmd移動)をクリックすると、自動的にマウスのポインタがAccessのウィンドウの中央に移動します。

Option Compare Database
Option Explicit

'Windows APIの構造体の定義
Private Type POINT
  x As Long
  y As Long
End Type

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

'マウスポインタ関係のAPIの宣言
Private Declare Function GetCursorPos Lib "user32" _
                          (lpPoint As POINT) As Long
Private Declare Function SetCursorPos Lib "user32" _
                          (ByVal x As Long, ByVal y As Long) As Long

'フォームサイズ取得関係のAPIの宣言
Private Declare Function GetWindowRect Lib "user32" _
                          (ByVal hWnd As Long, lpRect As RECT) As Long

Private Sub 詳細_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'詳細セクションのマウスボタン移動時

  Dim Mp As POINT

  'マウスのポインタの位置を取得
  GetCursorPos Mp

  'マウスのポインタの位置をテキストボックスに表示
  Me!txtX = Mp.x
  Me!txtY = Mp.y

End Sub

Private Sub cmd移動_Click()
'[移動]ボタンクリック時

  Dim lpRect As RECT
  Dim Mp As POINT
  Dim lngCenterHeight As Long
  Dim lngCenterWidth As Long

  'フォームのウィンドウのサイズを取得して構造体にセット
  GetWindowRect Me.hWnd, lpRect

  '構造体よりフォームの中央の座標値を計算
  With lpRect
    lngCenterHeight = (.Bottom - .Top) \ 2 + .Top
    lngCenterWidth = (.Right - .Left) \ 2 + .Left
  End With

  'その座標値にマウスポインタを移動
  SetCursorPos lngCenterWidth, lngCenterHeight

End Sub



実行例:

【マウスを移動したとき】
マウスを移動したとき
フォーム位置を変えてマウスを移動したとき
フォームに対するマウスポインタの位置は二つとも同じですが、それぞれフォームの位置が違うため、スクリーン座標値は異なる値になっていることが分かります。


【[移動]ボタンをクリックしたとき】 (それぞれフォームのサイズを変えて試しています)
[移動]ボタンをクリックしたとき
フォームサイズを変えて[移動]ボタンをクリックしたとき
| Index | Prev | Next |

この情報は参考になりましたか?、問題は解決しましたか?、もしまだなら......
T'sWareのワンポイトテクニカルアドバイスをご利用ください。3000円/件〜でご支援します。
スタンドアロンからSQL Server対応まで、オーダーメイドのシステムを短納期・安価でお届けします
 

Copyright © T'sWare All rights reserved