Subclassing

29/07/2011 - 12:44 von Lothar Geyer | Report spam
Ich will in einem UserControl einzelne Tastendrucke auswerten. Aber da
ich mit Subclassing nicht auf Du bin (und bisher eher "geklaute"
Routinen verwendet habe), haut das nicht so hin. Außerdem habe ich
verschiedene Ansàtze gefunden und weiß nicht recht, was ich tun soll.

In dem UserControl befindet sich eine Textbox, und ich will drei Tasten
abfangen: Return, Enter und Escape.

Versucht habe ich:

Im Initialize:

If hCallWndProcHook = 0 Then hCallWndProcHook = _
SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HandleKey, _
0, App.ThreadID)


Im Terminate:

If hCallWndProcHook <> 0 Then
UnhookWindowsHookEx hCallWndProcHook
hCallWndProcHook = 0
End If

Und als HandleKey:

Public Function HandleKey(ByVal lProcessCode As Long, _
ByVal lSentByCurrentThread As Boolean, _
udtCWP As CWPSTRUCT) As Long

Select Case udtCWP.Message

Case WM_CHAR, WM_KEYDOWN
If udtCWP.wParam = vbKeyCancel Or udtCWP.wParam = vbKeySeparator Then
RaiseEvent Suchen
Else
If wParam = vbKeyCancel Then
RaiseEvent Abbruch
Else
' Nachricht weiterleiten
CallWndProc = CallNextHookEx(WH_CALLWNDPROC, _
lProcessCode, lSentByCurrentThread, udtCWP)
End If
End If

Case Else
' Nachricht weiterleiten
CallWndProc = CallNextHookEx(WH_CALLWNDPROC, _
lProcessCode, lSentByCurrentThread, udtCWP)

End Select

Aber anscheinend mache ich etwas Grundsàtzliches falsch. Zunàchst einmal
will VB den Private Type CWPSTRUCT nicht akzeptieren.

Wer kann mir helfen?

Lothar Geyer
 

Lesen sie die antworten

#1 G.Wietzorek
29/07/2011 - 16:43 | Warnen spam
Am 29.07.2011 12:44, schrieb Lothar Geyer:
Ich will in einem UserControl einzelne Tastendrucke auswerten. Aber da
ich mit Subclassing nicht auf Du bin (und bisher eher "geklaute"
Routinen verwendet habe), haut das nicht so hin. Außerdem habe ich
verschiedene Ansàtze gefunden und weiß nicht recht, was ich tun soll.

In dem UserControl befindet sich eine Textbox, und ich will drei Tasten
abfangen: Return, Enter und Escape.

Versucht habe ich:

Im Initialize:

If hCallWndProcHook = 0 Then hCallWndProcHook = _
SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HandleKey, _
0, App.ThreadID)


Und als HandleKey:

Public Function HandleKey(ByVal lProcessCode As Long, _
ByVal lSentByCurrentThread As Boolean, _
udtCWP As CWPSTRUCT) As Long




Ob Du dafür WH_CALLWNDPROC nehmen und alles korrekt deklariert hast,
kann ich Dir nicht sagen, weil ich statt dessen WH_KEYBOARD nehme. Hab
Dir mal das entsprechende Modul aus einem meiner Steuerelemente hier
hinein kopiert (Zeilenumbrüche musst Du selbst korrigieren, habe ich
nicht im einzelnen korrigiert). Extendedcontrol ist das aufgebohrte
Steuerelement im Code - mit der Methode .HotkeyPress

Das solltest Du problemlos so àndern können, das es Deinen Bedarf
erfüllt. Möglich das die ein oder andere API Funktion nicht deklariert
ist, da da noch ein globales Deklarationsmodul existiert, sollte aber
für Dich wohl kein Problem sein.

Basis stammt übrigens aus dem Web - hab aber keine gültige Fundstelle
dafür mehr, der Autor möge mir die fehlende Quellenangabe daher
nachsehen

Gert


'


Option Explicit
Private Declare Function GetAsyncKeyState Lib "USER32" ( _
ByVal vKey As Long) As Integer

Private Declare Function CallNextHookEx Lib "user32.dll" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" ( _
ByVal hHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Long
Private Declare Function SetWindowsHookEx Lib "user32.dll" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Const WH_KEYBOARD = 2

Dim m_lKeyHookPtr As New Collection
Dim m_hkeyhook As Long

Private Function KeyboardFilter(ByVal ncode As Long, ByVal wParam As
Long, ByVal lParam As Long) As Long
Dim bKeyUp As Boolean
Dim bAlt As Boolean
Dim bCtrl As Boolean
Dim bShift As Boolean
Dim bEnter As Boolean
Dim bTab As Boolean
Dim bFKey As Boolean
Dim bEscape As Boolean
Dim bDelete As Boolean
Dim bInsert As Boolean
Dim bBack As Boolean
Dim wMask As KeyCodeConstants
Dim cT As extendedcontrol
Dim i As Long
Dim iC
Const HC_ACTION = 0

On Error GoTo ErrorHandler

bShift = (GetAsyncKeyState(vbKeyShift) <> 0)
bAlt = ((lParam And &H20000000) = &H20000000)
bCtrl = (GetAsyncKeyState(vbKeyControl) <> 0)


If ncode = HC_ACTION And m_lKeyHookPtr.count > 0 Then
bKeyUp = ((lParam And &H80000000) = &H80000000)
bShift = (GetAsyncKeyState(vbKeyShift) <> 0)
bAlt = ((lParam And &H20000000) = &H20000000)
bCtrl = (GetAsyncKeyState(vbKeyControl) <> 0)
bFKey = ((wParam >= vbKeyF1) And (wParam <= vbKeyF12))
bEscape = (wParam = vbKeyEscape)
bDelete = (wParam = vbKeyDelete)
bInsert = (wParam = vbKeyInsert)
bBack = (wParam = vbKeyBack)
bEnter = (wParam = vbKeyReturn)
bTab = (wParam = vbKeyTab)

If bAlt Or bCtrl Or bFKey Or bEscape Or bDelete Or bInsert Or
bBack Or bEnter Or bTab Then
wMask = Abs(bShift * vbShiftMask) Or Abs(bCtrl * vbCtrlMask)
Or Abs(bAlt * vbAltMask)
On Error Resume Next
For Each iC In m_lKeyHookPtr
' Alt- or Ctrl- key Kombination:
Set cT = extendedcontrolFromPointer(iC)
If Not cT Is Nothing Then
If bKeyUp Then
If cT.HotKeyPress(wMask, wParam, True) Then
KeyboardFilter = 1
Exit Function
End If
Else
If cT.HotKeyPress(wMask, wParam, False) Then
KeyboardFilter = 1
Exit Function
End If
End If
End If
Next
End If
End If
KeyboardFilter = CallNextHookEx(m_hkeyhook, ncode, wParam, lParam)

Exit Function

ErrorHandler:
debug.print "Keyboardfilter::" & err.description
KeyboardFilter = CallNextHookEx(m_hkeyhook, ncode, wParam, lParam)
Exit Function

End Function

Public Sub DetachKeyboardHook(cThis As extendedcontrol)
Dim lptr As Long

On Error Resume Next
lptr = ObjPtr(cThis)
m_lKeyHookPtr.Remove CStr("K" & lptr)
If m_lKeyHookPtr.count = 0 Then
If (m_hkeyhook <> 0) Then
UnhookWindowsHookEx m_hkeyhook
m_hkeyhook = 0
End If
End If
Err.Clear
End Sub
Public Sub AttachKeyboardHook(cThis As extendedcontrol)
Dim lpfn As Long
Dim lptr As Long
On Error Resume Next
lptr = ObjPtr(cThis)
If lptr <> 0 Then
If m_lKeyHookPtr.count = 0 Then
lpfn = HookAddress(AddressOf KeyboardFilter)
m_hkeyhook = SetWindowsHookEx(WH_KEYBOARD, lpfn, 0&,
GetCurrentThreadId())
Debug.Assert (m_hkeyhook <> 0)
End If
m_lKeyHookPtr.Add lptr, "K" & CStr(lptr)
End If
Err.Clear
End Sub
Private Function HookAddress(ByVal lptr As Long) As Long
HookAddress = lptr
End Function

Private Property Get extendedcontrolFromPointer(ByVal lptr As Long) As
extendedcontrol
Dim oTemp As Object
If lptr <> 0 Then
CopyMemory oTemp, lptr, 4
Set extendedcontrolFromPointer = oTemp
CopyMemory oTemp, 0&, 4
End If
End Property


"Probleme kann man niemals mit derselben Denkweise lösen, durch die sie
entstanden sind."
Albert Einstein

Ähnliche fragen