VB5 Windows Hook Library Binary (17K)
VB5 Windows Hook Library Full Source (61K)
VB6 Windows Hook Library Binary (17K)
VB6 Windows Hook Library Full Source (60K)
27 Jun 2003
Added support for Journal Record and Playback hooks
Added MsgFilterlParam method for working with the WH_GETMESSAGE Hook.
vbAccelerator Accelerator Control
(Incomplete) Docking Forms In VB
vbAccelerator - Contents of code file: KeyEvents_frmKeyEvents.frm
VERSION 5.00
Begin VB.Form frmKeyEvents
Caption = "vbAccelerator Hook Library - Keyboard Events"
ClientHeight = 5625
ClientLeft = 6210
ClientTop = 2310
ClientWidth = 5385
Icon = "frmKeyEvents.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5625
ScaleWidth = 5385
Begin VB.ListBox lstTest
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 840
Left = 60
TabIndex = 4
Top = 2280
Width = 2715
End
Begin VB.ComboBox cboTest
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2940
TabIndex = 3
Text = "Combo1"
Top = 1320
Width = 2295
End
Begin VB.CommandButton cmdTest2
Caption = "Command1"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2940
TabIndex = 9
Top = 4320
Width = 1275
End
Begin VB.CommandButton cmdTest1
Caption = "Command1"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2940
TabIndex = 8
Top = 3960
Width = 1275
End
Begin VB.ListBox lstUnaffected
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 840
Left = 60
TabIndex = 7
Top = 4380
Width = 2775
End
Begin VB.TextBox txtUnaffected
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 60
TabIndex = 6
Text = "Text1"
Top = 3960
Width = 2775
End
Begin VB.TextBox txtTest
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 60
MultiLine = -1 'True
TabIndex = 2
Text = "frmKeyEvents.frx":1272
Top = 1320
Width = 2715
End
Begin VB.Label lblInfo
Caption = "These controls are here to set focus to so you prove
that the hook works regardless of focused control."
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 2
Left = 60
TabIndex = 5
Top = 3480
Width = 5175
End
Begin VB.Label lblInfo
Caption = $"frmKeyEvents.frx":1278
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Index = 1
Left = 60
TabIndex = 0
Top = 120
Width = 5235
End
Begin VB.Label lblInfo
Caption = "The Hook procedure is used to emulate tab trapping
in these controls:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 60
TabIndex = 1
Top = 960
Width = 5175
End
End
Attribute VB_Name = "frmKeyEvents"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Implements IWindowsHook
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As
Integer
Private Sub FillList(ByRef ctlList As Control)
Dim lI As Long
For lI = 1 To 100
ctlList.AddItem "Test Item " & lI
Next lI
End Sub
Private Property Get ShiftPressed() As Boolean
ShiftPressed = (GetAsyncKeyState(vbKeyShift) <> 0)
End Property
Private Sub Form_Load()
InstallHook Me, WH_KEYBOARD
FillList lstTest
FillList cboTest
FillList lstUnaffected
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
RemoveHook Me, WH_KEYBOARD
End Sub
Private Function IWindowsHook_HookProc(ByVal eType As EHTHookTypeConstants,
ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long, bConsume As
Boolean) As Long
Dim lI As Long
Static bInHere As Boolean
If KeyBoardlParam(lParam).KeyDown Then
Select Case True
Case Me.ActiveControl = txtTest
If wParam = vbKeyTab Then
If Not ShiftPressed Then
txtTest.SelText = " "
bConsume = True
End If
End If
Case Me.ActiveControl = lstTest
If wParam = vbKeyTab Then
bConsume = True
lI = lstTest.ListIndex
If ShiftPressed Then
lI = lI - 1
Else
lI = lI + 1
End If
On Error Resume Next
lstTest.ListIndex = lI
End If
Case Me.ActiveControl = cboTest
If wParam = vbKeyTab Then
If Not ShiftPressed Then
cboTest.SelText = " "
bConsume = True
End If
End If
End Select
Else
If wParam = vbKeyEscape Then
If Not bInHere Then
bInHere = True
If vbYes = MsgBox("Are you sure you want to exit?", vbYesNo Or
vbQuestion) Then
Unload Me
End If
bInHere = False
End If
End If
End If
End Function
