[VB6] Subclassing, intercettare WM_KEYDOWN

[raffaeu]

Ciao grazie a Massimo VB sono riuscito a creare una funzione di subclassing (intercettazione a priori degli eventi windows), purtroppo riscontro grossi problemi con il subClassing dell' evento KeyDown, in pratica non mi viene intercettato ..

HO una MDI e una frm Child nella quale avvio il subClassing e il KeyPreview è inpostato a true.

Codice :

Option Explicit
   Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long _
                            , ByVal ndx As Long, ByVal newValue As Long) As Long
   Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
                (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long _
                            , ByVal wParam As Long, ByVal lParam As Long) As Long
   Const GWL_WNDPROC = -4                           ' Per "SetWindowLong"
   Private SaveHWnd As Long                         ' L'Handle della finestra subclassata
   Private OldProcAddr As Long                      ' L'indirizzo della WindowProcedure originale
   ' Le costanti di messaggi
   Const WM_KILLFOCUS = &H8
   Const WM_SETFOCUS = &H7
   Const WM_SYSKEYDOWN = &H104
   Const WM_SYSKEYUP = &H105
   Const WM_ACTIVATEAPP = &H1C                      ' Applicazione attivata (wParam) o disattivata
   Const WM_KEYDOWN = &H100                         ' KeyDown
   Const WM_KEYUP = &H101                           ' KeyUp
   Const WM_LBUTTONDBLCLK = &H203                   ' Doppio click Sx
   Const WM_LBUTTONDOWN = &H201                     ' MouseDown Sx
   Const WM_LBUTTONUP = &H202                       ' MouseUp Sx
   Const WM_MBUTTONDBLCLK = &H209                   ' Doppio click Middle
   Const WM_MBUTTONDOWN = &H207                     ' MouseDown Middle
   Const WM_MBUTTONUP = &H208                       ' MouseUp Middle
   Const WM_MOUSEMOVE = &H200                       ' MouseMove
   Const WM_MOUSEWHELLSCROLL = &H20A                ' (manca in API Loader) Scroll di rotellina Mouse wParam > 0 = su; wParam < 0 = giù
   Const WM_MOVE = &H3                              ' La Finestra è stata mossa
   Const WM_NULL = &H0                              ' Messaggio NULLO
   Const WM_PAINT = &HF                             ' Ridisegno della finestra
   Const WM_RBUTTONDBLCLK = &H206                   ' Doppio-click Dx
   Const WM_RBUTTONDOWN = &H204                     ' MouseDown Dx
   Const WM_RBUTTONUP = &H205                       ' MouseUp Dx
   Const WM_SHOWWINDOW = &H18                       ' La finestra è stata mostrata
   Const WM_SIZE = &H5                              ' La finestra è stata ridimensionata
   Const WM_SYSCOLORCHANGE = &H15                   ' modifiche ai colori di sistema
   Const WM_SYSCOMMAND = &H112                      ' comando di sistema (un menu di sistema, un pulsante: chiudi, minimizza...)
   Const WM_TIMECHANGE = &H1E                       ' modificate le impostazioni di data e ora del sistema
   Const WM_TIMER = &H113                           ' evento del Timer (creato con CreateTimer)
Sub StartSubclassing(ByVal hWnd As Long)
   ' Avvia il SubClassing
   SaveHWnd = hWnd                  ' Memorizza Hanlde Window della finestra da subclassare per ripristinarlo poi
   ' Modifica l'indirizzo della Window Procedure originale a quello della Function "WndProc"
   ' e memorizza in "OldProcAddr" quello originale.
   OldProcAddr = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Sub StopSubclassing()
   ' Termina il SubClassing reimpostando l'indirizzo di Window Procedure originale
   SetWindowLong SaveHWnd, GWL_WNDPROC, OldProcAddr
End Sub

' Window Procedure personalizzata:
Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    ' Gestisce il messaggio ricevuto
    Select Case uMsg
        Case WM_SYSCOMMAND:
            
        Case WM_SETFOCUS:
            
        Case WM_KILLFOCUS:
        
        Case WM_KEYDOWN:
            Select Case wParam
                Case "VK_PAGEDOWN":
                    MsgBox lParam
            End Select
        Case WM_KEYUP:
        
        Case WM_SYSKEYDOWN:
            
    End Select
   ' Invia il messaggio ricevuto alla Window Procedure originale, e
   ' restituisce a Windows il suo valore di ritorno.
   ' N.B: Questo è necessario per far si che Windows abbia conferma che l'evento
   '      comunicato alla Window (tramite messaggio) è stato intercettato e gestito.
   WndProc = CallWindowProc(OldProcAddr, hWnd, uMsg, wParam, lParam)
End Function

Qualcuno è in grado di dirmi come mai non mi passa mai di li ...

[xegallo]

http://www.codeguru.com/vb/gen/vb_sy...cle.php/c4829/

[raffaeu]

Grazie xegallo, ma purtroppo non è facile trovare in giro un buon tutorial a riguardo, questo mi sembra ottimo.

Thanks!!

[raffaeu]

Ho risolto, con questo tutorial ho costruito un hooking della tastiera.

FORM :

Option Explicit

Implements KeyboardHook

Private Sub Form_Load()
  Set Keyboardhandler.KeyboardHook = Me
  HookKeyboard
End Sub

Private Sub Form_Unload(Cancel As Integer)
  UnhookKeyboard
End Sub

Private Function KeyBoardHook_PageDown() As Boolean
    Debug.Print "PageDOwn"
End Function

MODULO :

Option Explicit

Public Declare Function UnhookWindowsHookEx Lib "user32" _
  (ByVal hHook As Long) As Long

Public 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 Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cb As Long)

Private Declare Function GetAsyncKeyState Lib "user32" _
  (ByVal vKey As Long) As Integer

Private Declare Function CallNextHookEx Lib "user32" _
   (ByVal hHook As Long, _
   ByVal nCode As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long


Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  flags As Long
  time As Long
  dwExtraInfo As Long
End Type

' Low-Level Keyboard Constants
Private Const HC_ACTION = 0
Private Const LLKHF_EXTENDED = &H1
Private Const LLKHF_INJECTED = &H10
Private Const LLKHF_ALTDOWN = &H20
Private Const LLKHF_UP = &H80

' Virtual Keys
Public Const VK_TAB = &H9
Public Const VK_CONTROL = &H11
Public Const VK_ESCAPE = &H1B
Public Const VK_DELETE = &H2E
Public Const VK_PAGEDOWN = vbKeyPageDown

Private Const WH_KEYBOARD_LL = 13&
Public KeyboardHandle As Long


Public KeyboardHook As KeyboardHook


' Questa funzione mi intercetta quello che premo
Public Function IsHooked(ByRef Hookstruct As KBDLLHOOKSTRUCT) _
            As Boolean
   
  If (KeyboardHook Is Nothing) Then
    IsHooked = False
    Exit Function
  End If
  'PAGE DOWN
  If (Hookstruct.vkCode = VK_PAGEDOWN) Then
      
    IsHooked = KeyboardHook.PageDown
    
    Call HookedState(IsHooked, "PageDown Pressed")
    Exit Function
  End If
  
End Function

Private Sub HookedState(ByVal Hooked As Boolean, _
                        ByVal Text As String)
If (Hooked) Then Debug.Print Text
End Sub


Public Function KeyboardCallback(ByVal Code As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long

  Static Hookstruct As KBDLLHOOKSTRUCT

  If (Code = HC_ACTION) Then
    ' Copy the keyboard data out of the lParam (which is a pointer)
    Call CopyMemory(Hookstruct, ByVal lParam, Len(Hookstruct))

    If (IsHooked(Hookstruct)) Then
      KeyboardCallback = 1
      Exit Function
    End If

  End If

  KeyboardCallback = CallNextHookEx(KeyboardHandle, _
    Code, wParam, lParam)

End Function

Public Sub HookKeyboard()
  KeyboardHandle = SetWindowsHookEx( _
    WH_KEYBOARD_LL, AddressOf KeyboardCallback, _
    App.hInstance, 0&)
    
  Call CheckHooked
End Sub

Public Sub CheckHooked()
  If (Hooked) Then
    Debug.Print "Keyboard hooked"
  Else
    Debug.Print "Keyboard hook failed: " & Err.LastDllError
  End If
End Sub

Private Function Hooked()
  Hooked = KeyboardHandle <> 0
End Function

Public Sub UnhookKeyboard()
  If (Hooked) Then
    Call UnhookWindowsHookEx(KeyboardHandle)
  End If
End Sub

CLASSE :

Public Function PageDown() As Boolean

End Function

Ora quando premo PageDown, l' evento viene chiamato diverse volte, come mai? Da cosa è dovuto? Devo abbassare la velocità del cursore per caso?

:-)