keys Shift, Ctrl, Alt, Cmd and AlphaLock. And furthermore the new version
Code: Select all
EnableExplicit
ImportC ""
GetEventClass(Event)
EndImport
; Event Class Constants
#kEventClassMouse = 'mous'
#kEventClassKeyboard = 'keyb'
; Event Modifier Constants
#cmdKeyBit = 8
#shiftKeyBit = 9
#alphaLockBit = 10
#optionKeyBit = 11
#controlKeyBit = 12
; Event Modifier Bits
#cmdKey = 1 << #cmdKeyBit
#shiftKey = 1 << #shiftKeyBit
#alphaLock = 1 << #alphaLockBit
#optionKey = 1 << #optionKeyBit
#controlKey = 1 << #controlKeyBit
; Character Codes
#kHomeCharCode = 1
#kEnterCharCode = 3
#kEndCharCode = 4
#kBackspaceCharCode = 8
#kTabCharCode = 9
#kPageUpCharCode = 11
#kPageDownCharCode = 12
#kReturnCharCode = 13
#kFunctionKeyCharCode = 16
#kEscapeCharCode = 27
#kLeftArrowCharCode = 28
#kRightArrowCharCode = 29
#kUpArrowCharCode = 30
#kDownArrowCharCode = 31
#kSpaceCharCode = 32
#kDeleteCharCode = 127
; Keyboard Event Constants
#kEventRawKeyDown = 1
#kEventRawKeyUp = 3
#kEventRawKeyModifiersChanged = 4
; Keyboard Event Parameters and Types
#kEventParamKeyCode = 'kcod'
#kEventParamKeyMacCharCodes = 'kchr'
#kEventParamKeyModifiers = 'kmod'
; Mouse Events
#kEventMouseDown = 1
#kEventMouseUp = 2
#kEventMouseWheelMoved = 10
; Mouse Button Constants
#kEventMouseButtonPrimary = 1
#kEventMouseButtonSecondary = 2
#kEventMouseButtonTertiary = 3
; Mouse Wheel Constants
#kEventMouseWheelAxisX = 0
#kEventMouseWheelAxisY = 1
; Mouse Event Parameters
#kEventParamMouseButton = 'mbtn'
#kEventParamMouseWheelAxis = 'mwax'
#kEventParamMouseWheelDelta = 'mwdl'
#typeMouseButton = 'mbtn'
#typeMouseWheelAxis = 'mwax'
; Mouse Tracking Constants
#kMouseTrackingMouseDown = 1
#kMouseTrackingMouseUp = 2
; Types
#typeChar = 'TEXT'
#typeSInt32 = 'long'
#typeUInt32 = 'magn'
Structure EventTypeSpec
EventClass.L
EventKind.L
EndStructure
Define EventHandlerUPP.L
Define i.L
Dim FnKey.L(18)
For i = 0 To 18
Read.L FnKey(i)
Next i
ProcedureC EventHandler(*NextEventHandler, Event.L, UserData.L)
Shared FnKey.L()
Protected i.L
Protected KeyCode.L
Protected KeyModifier.L
Protected KeyModifierList.S
Protected KeyName.S
Protected MouseButtonType.L
Protected MouseWheelAxis.L
Protected MouseWheelDelta.L
Protected WheelInfo.S
Select GetEventClass(Event)
Case #kEventClassMouse
Select GetEventKind_(Event)
Case #kEventMouseDown
If GetEventParameter_(Event, #kEventParamMouseButton, #typeMouseButton, 0, SizeOf(MouseButtonType), 0, @MouseButtonType) = 0
If GetEventParameter_(Event, #kEventParamKeyModifiers, #typeUInt32, 0, SizeOf(KeyModifier), 0, @KeyModifier) = 0
Select MouseButtonType
Case #kEventMouseButtonPrimary
If KeyModifier = #controlKey
SetGadgetText(1, "Right mouse button")
Else
SetGadgetText(1, "Left mouse button")
EndIf
Case #kEventMouseButtonSecondary
SetGadgetText(1, "Right mouse button")
Case #kEventMouseButtonTertiary
SetGadgetText(1, "Middle mouse button")
EndSelect
EndIf
EndIf
Case #kEventMouseUp
SetGadgetText(1, "")
Case #kEventMouseWheelMoved
If GetEventParameter_(Event, #kEventParamMouseWheelAxis, #typeMouseWheelAxis, 0, SizeOf(MouseWheelAxis), 0, @MouseWheelAxis) = 0
Select MouseWheelAxis
Case #kEventMouseWheelAxisX
WheelInfo = "Mouse wheel moved horizontally"
Case #kEventMouseWheelAxisY
WheelInfo = "Mouse wheel moved vertically"
EndSelect
EndIf
If GetEventParameter_(Event, #kEventParamMouseWheelDelta, #typeSInt32, 0, 4, 0, @MouseWheelDelta) = 0
WheelInfo + ", Delta = " + Str(MouseWheelDelta)
SetGadgetText(1, WheelInfo)
EndIf
EndSelect
Case #kEventClassKeyboard
Select GetEventKind_(Event)
Case #kEventRawKeyDown
GetEventParameter_(Event, #kEventParamKeyMacCharCodes, #typeChar, 0, SizeOf(KeyCode), 0, @KeyCode)
Select KeyCode
Case #kBackspaceCharCode
KeyName = "Backspace"
Case #kDeleteCharCode
KeyName = "Delete"
Case #kEndCharCode
KeyName = "End"
Case #kEnterCharCode
KeyName = "Enter"
Case #kEscapeCharCode
KeyName = "Esc"
Case #kFunctionKeyCharCode
If GetEventParameter_(Event, #kEventParamKeyCode, #typeUInt32, 0, SizeOf(KeyModifier), 0, @KeyCode) = 0
For i = 0 To 18
If KeyCode = FnKey(i)
KeyName = "F" + Str(i + 1)
Break
EndIf
Next i
EndIf
Case #kHomeCharCode
KeyName = "Home"
Case #kReturnCharCode
KeyName = "Return"
Case #kPageDownCharCode
KeyName = "PageDown"
Case #kPageUpCharCode
KeyName = "PageUp"
Case #kSpaceCharCode
KeyName = "Space"
Case #kTabCharCode
KeyName = "Tab"
Case #kUpArrowCharCode
KeyName = "UpArrow"
Case #kDownArrowCharCode
KeyName = "DownArrow"
Case #kLeftArrowCharCode
KeyName = "LeftArrow"
Case #kRightArrowCharCode
KeyName = "RightArrow"
Default
KeyName = LCase(Chr(KeyCode))
EndSelect
Case #kEventRawKeyUp
KeyName = ""
EndSelect
If GetEventParameter_(Event, #kEventParamKeyModifiers, #typeUInt32, 0, SizeOf(KeyModifier), 0, @KeyModifier) = 0
If KeyModifier & #cmdKey
KeyModifierList + "<Cmd> "
EndIf
If KeyModifier & #shiftKey
KeyModifierList + "<Shift> "
EndIf
If KeyModifier & #alphaLock
KeyModifierList + "<AlphaLock> "
EndIf
If KeyModifier & #optionKey
KeyModifierList + "<Alt> "
EndIf
If KeyModifier & #controlKey
KeyModifierList + "<Ctrl> "
EndIf
EndIf
If KeyCode
SetGadgetText(1, KeyModifierList + "<" + KeyName + ">")
Else
SetGadgetText(1, KeyModifierList)
EndIf
EndSelect
If *NextEventHandler
CallNextEventHandler_(*NextEventHandler, Event)
EndIf
EndProcedure
Dim EventTypes.EventTypeSpec(5)
OpenWindow(0, 200, 100, 420, 70, "Detect mouse button, wheel, key and modifier events")
TextGadget(0, 10, 10, WindowWidth(0) - 20, 20, "Press and hold mouse button or key:", #PB_Text_Center)
TextGadget(1, 10, 35, WindowWidth(0) - 20, 20, "", #PB_Text_Border | #PB_Text_Center)
; ----- Install EventHandler
EventHandlerUPP = NewEventHandlerUPP_(@EventHandler())
; ----- Intercept mouse button down and up events
EventTypes(0)\EventClass = #kEventClassMouse
EventTypes(0)\EventKind = #kEventMouseDown
EventTypes(1)\EventClass = #kEventClassMouse
EventTypes(1)\EventKind = #kEventMouseUp
; ----- Intercept raw key down and up events
EventTypes(2)\EventClass = #kEventClassKeyboard
EventTypes(2)\EventKind = #kEventRawKeyDown
EventTypes(3)\EventClass = #kEventClassKeyboard
EventTypes(3)\EventKind = #kEventRawKeyUp
; ----- Intercept modifier key changes
EventTypes(4)\EventClass = #kEventClassKeyboard
EventTypes(4)\EventKind = #kEventRawKeyModifiersChanged
; ----- Intercept mouse wheel movement
EventTypes(5)\EventClass = #kEventClassMouse
EventTypes(5)\EventKind = #kEventMouseWheelMoved
InstallEventHandler_(GetWindowEventTarget_(WindowID(0)), EventHandlerUPP, 6, @EventTypes(), 0, 0)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
End
DataSection
Data.L 122, 120, 99, 118, 96, 97, 98, 100, 101, 109
Data.L 103, 111, 105, 107, 113, 106, 64, 79, 80
EndDataSection
so that this code runs without change in Snow Leopard, Lion and Mountain Lion. Beginning with PB 5.00 you have to set the subsystem to "Carbon" in "Compiler/Compiler Options.../Library Subsystem:".