Date: 02-16-2022
Return to Index
created by gbSnippets
'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 Long) As Long
Select Case Msg
Case %WM_KeyUp : AddText "wm_keyup"
End Select
Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
'Compilable Example: (Jose Includes)
'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
%Unicode=1
#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 Long) As 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, Msg, wParam, lParam)
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
http://www.garybeene.com/sw/gbsnippets.htm