VB6 マウスクリック 取得方法 (ID:89550)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 http://www.geocities.co.jp/SiliconValley/7406/tips/mouse/mouse2.html 上記を参考に、DirectInputで書いてみました。 他アプリのウィンドウ上でクリックされても判定できます。 '-------- Option Explicit Implements DirectXEvent8 Private DX As DirectX8 Private DI As DirectInput8 Private Mouse As DirectInputDevice8 Private mhEventM As Long Private Const MAX_BUFFERSIZE As Long = 10 Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) If eventid <> mhEventM Then Exit Sub End If Dim devdata(MAX_BUFFERSIZE - 1) As DIDEVICEOBJECTDATA Dim datacnt As Long On Error Resume Next datacnt = Mouse.GetDeviceData(devdata, DIGDD_DEFAULT) If Err.Number <> 0 Then datacnt = 0 Mouse.Acquire End If On Error GoTo 0 Dim I As Long For I = 0 To datacnt - 1 Select Case devdata(I).lOfs Case DIMOFS_X 'AppendLog "X Move :" & CStr(devdata(I).lData) Case DIMOFS_Y 'AppendLog "Y Move :" & CStr(devdata(I).lData) Case DIMOFS_BUTTON0 AppendLog "Button0:" & CStr(devdata(I).lData) End Select Next End Sub Private Sub Form_Load() Set DX = New DirectX8 Set DI = DX.DirectInputCreate() Set Mouse = DI.CreateDevice("GUID_SysMouse") Mouse.SetCommonDataFormat DIFORMAT_MOUSE2 Mouse.SetCooperativeLevel Me.hWnd, _ DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE Dim diprop As DxVBLibA.DIPROPLONG With diprop .lHow = DIPH_DEVICE .lObj = 0 .lData = 100 End With Mouse.SetProperty "DIPROP_BUFFERSIZE", diprop mhEventM = DX.CreateEvent(Me) Mouse.SetEventNotification mhEventM Mouse.Acquire End Sub Private Sub AppendLog(ByVal Msg As String) List1.AddItem Msg, 0 'List1.TopIndex = List1.NewIndex List1.ListIndex = 0 End Sub Private Sub Form_QueryUnload(Cancel%, UnloadMode%) Mouse.Unacquire DX.DestroyEvent mhEventM mhEventM = 0 End Sub Private Sub Form_Unload(Cancel As Integer) Set Mouse = Nothing Set DI = Nothing Set DX = Nothing End Sub