.Message Detection (TextBox SubClassing)

Category: Keyboard

Date: 03-28-2012

Return to Index


 
'Normally, keystroke messages sent to the textbox are handled by its class window
'procedure and are not received by the TextBox Or its Parent Control in a PowerBASIC
'application. By subclassing the textbox, messages can be intercepted and responded
'to in a PowerBASIC application substitute windows procedure.
 
'Primary Code:
'Subclassing is accomplished with this:
OldProc& = SetWindowLong(GetDlgItem(hDlg, %ID_Control), %GWL_WndProc, Codeptr(NewProc))  'subclass
'And requires the NewProc like this:
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Select Case Msg
      Case %WM_KeyUp        : AddText "wm_keyup"
   End Select
   Function = CallWindowProc(OldProc&, hWnd, MsgwParamlParam)
End Function
 
'Compilable Example:
'In this example, subclassing is used to provide access to keystroke messages.
'The NewProc above is expanded to include more keystroke messages.
'For %WM_Char messages, the most commonly used keystroke message,
'message information is displayed in a second textbox.
 
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
Global hDlg As Dword, hTextBox As Dword, OldProc&
%ID_Control = 500
 
Function PBMain() As Long
   Local style&
   Dialog New Pixels, 0, "Test Code",300,300,200,205, %WS_OverlappedWindow To hDlg
   Style& = %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll Or %ES_MultiLine Or %ES_AutoVScroll Or %ES_WantReturn
   Control Add TextBox, hDlg, %ID_Control, "Right-mouse click me!", 15,10,170,50, Style&
   Control Add TextBox, hDlg, 200, "<messages>", 15,70,170,120, Style&
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_InitDialog
         OldProc& = SetWindowLong(GetDlgItem(hDlg, %ID_Control), %GWL_WndProc, Codeptr(NewProc))  'subclass
      Case %WM_Destroy
         SetWindowLong hTextBox, %GWL_WNDPROC, OldProc&   'un-subclass
   End Select
End Function
 
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Select Case Msg
      Case %WM_Char
         AddText Str$(wParam) + " : " + Chr$(wParam)
         AddText "wm_char"
      Case %WM_KeyUp        : AddText "wm_keyup"
      Case %WM_KeyDown      : AddText "wm_keydown"
      Case %WM_SysKeyDown   : AddText "wm_syskeydown"
      Case %WM_SysKeyUp     : AddText "wm_syskeyup"
      Case %WM_SysDeadChar  : AddText "wm_sysdeadchar"
      Case %WM_DeadChar      : AddText "wm_deadchar"
      Case %WM_AppCommand  : AddText "wm_appcommand"
      Case %WM_KillFocus       : AddText "wm_killfocus"
      Case %WM_SetFocus       : AddText "wm_setfocus"
      Case %WM_Activate       : AddText "wm_activate"
      Case %WM_HotKey        : AddText "wm_hotkey"
   End Select
   Function = CallWindowProc(OldProc&, hWnd, MsgwParamlParam)
End Function
 
Sub AddText(sText$)
   Static iCount&
   Incr iCount&
   Local temp$
   Control Get Text hDlg, 200 To temp$
   temp$ = Format$(iCount&, "0000   ") + sText$ +  $crlf + temp$
   Control Set Text hDlg, 200, temp$
End Sub
 
'gbs_00189
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm