VB Forum / General / June 2007

I'm not sure how your mention of AutoCad VBA fits into this but I assume you
are trying to detect the current state of the right mouse button system wide
from your VB or VBA program? In that case a low level hook might be the best
solution. When hooking, unless you jump through lots of hoops to achieve
"safe in the IDE" hooking, you obviously need to be careful when working in
the VB IDE that you close your app properly using the normal Close button
(and not use the VB Run / End menu while the hook is still on), but in a
compiled exe there are no such problems. Try the following code. Paste the
first block into a VB Form and the second block into a standarde code
module. At runtime your app can check the current state of the right mouse
button at any time merely by checking the value of the Publicly declared
variable RightButton, which will return True or False:

' *** START OF FORM CODE ***
Option Explicit
Private Sub Form_Load()
SetMouseHook
End Sub

Private Sub Form_Unload(Cancel As Integer)
ReleaseMouseHook
End Sub
' *** END OF FORM CODE ***
'
' *** START OF MODULE CODE ***
Option Explicit
Private Declare Function SetWindowsHookEx _
 Lib "user32" Alias "SetWindowsHookExA" _
 (ByVal idHook As Long, ByVal lpfn As Long, _
 ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx _
 Lib "user32" (ByVal hHook As Long) As Long
Private Const WH_MOUSE_LL As Long = 14
Private Declare Function CallNextHookEx _
 Lib "user32" (ByVal hHook As Long, _
 ByVal nCode As Long, ByVal wParam As Long, _
 lParam As Any) As Long
Private Const HC_ACTION = 0
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Hook As Long
Public RightButton As Boolean

Public Sub SetMouseHook()
Hook = SetWindowsHookEx(WH_MOUSE_LL, _
   AddressOf MouseProc, App.hInstance, 0)
End Sub

Public Sub ReleaseMouseHook()
UnhookWindowsHookEx Hook
End Sub

Private Function MouseProc(ByVal nCode As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long
If (nCode = HC_ACTION) Then
 Select Case wParam
   Case WM_RBUTTONDOWN: RightButton = True
   Case WM_RBUTTONUP: RightButton = False
 End Select
End If
' Done our job so allow the system to carry on as normal
MouseProc = CallNextHookEx _
   (0, nCode, wParam, ByVal lParam)
End Function
' *** START OF MODULE CODE ***

GetKeyboardState may be a better option (if you don't go with the hook).
GetAsyncKeyState also tells you if something's been pressed since last call
(see MSDN). May be confusing for your purposes.
'===============
Option Explicit

Private Declare Function _
  GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long

Private Function MouseIsDown() As Boolean
  Const VK_LBUTTON = &H1
  Dim b(255) As Byte
  Call GetKeyboardState(b(0))
  If b(VK_LBUTTON) > 127 Then 'Mouse is down
     MouseIsDown = True
  End If
End Function

Private Function RMouseIsDown() As Boolean
  Const VK_RBUTTON = &H2
  Dim b(255) As Byte
  Call GetKeyboardState(b(0))
  If b(VK_RBUTTON) > 127 Then 'RMouse is down
     RMouseIsDown = True
  End If
End Function

Private Sub Form_Load()
  With Timer1
     .Interval = 100
     .Enabled = True
  End With
End Sub

Private Sub Timer1_Timer()
  Me.Caption = "L-" & MouseIsDown & " R-" & RMouseIsDown
End Sub
'===============

This VB6 code needs a new project with an empty form. It'll build the form
and show the states of all keys and mouse buttons. It also shows that all
keys and buttons are "toggle" buttons, like CapsLock, etc.
'===================
Option Explicit

Private Declare Function _
  GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private WithEvents Timer1 As Timer
Private mobjLabels(255) As Label

Private Sub Form_Load()
  Dim i As Integer
  Dim j As Integer
  Dim iIndex As Integer
  Const STARTXY = 8

  Me.ScaleMode = vbPixels

  For i = 0 To 15
     For j = 0 To 15
     iIndex = i * 16 + j
     Set mobjLabels(iIndex) _
        = Controls.Add("VB.Label", "lbl" & iIndex)

     With mobjLabels(iIndex)
        .BorderStyle = 1
        .Move 30 * j + STARTXY, 21 * i + STARTXY, 26, 17
        .Caption = "00"
        .BackColor = vbButtonFace
        .Visible = True
        .ZOrder
     End With
     Next
  Next

  Set Timer1 = Controls.Add("VB.Timer", "WhoCares")
  With Timer1
     .Interval = 80
     .Enabled = True
  End With

  Me.Height = 400 * Screen.TwipsPerPixelY
  Me.Width = 500 * Screen.TwipsPerPixelX

End Sub

Private Sub Timer1_Timer()
  Dim btArray(255) As Byte
  Dim sList As String
  Dim i As Integer

  Call GetKeyboardState(btArray(0))

  For i = 0 To 255
     With mobjLabels(i)
        .Caption = Right$("0" & Hex$(btArray(i)), 2)
        Select Case btArray(i)
           Case 0
              .BackColor = vbButtonFace
           Case Is < 127
              .BackColor = vbGreen
           Case Else
              .BackColor = vbRed
              sList = sList & GetChar(i) & " "
        End Select
     End With
  Next

  Me.Caption = "Keys pressed now: " & sList

End Sub

Private Function GetChar(ByVal ByteIn As Byte) As String

  GetChar = Right$("0" & Hex$(ByteIn), 2)

  If ByteIn < 32 Or ByteIn > 127 Then
     ByteIn = 63 '="?"
  End If

  GetChar = GetChar & "(" & Chr$(ByteIn) & ")"

End Function
'===================