Date: 02-16-2022
Return to Index
created by gbSnippets
'If you have many subclassed controls, such as textboxes, and you'd like use the same
'subclassing procedure to handle them all, you need to be able to get either the handle
'or control ID of the control in messages that are sent.
'Primary Code:
'This code assumes the handles are individually available (an array would work too)
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_ContextMenu
Select Case hWnd
Case hTB1 : MsgBox "TB1"
Case hTB2 : MsgBox "TB2"
Case hTB3 : MsgBox "TB3"
End Select
Function = 0 : Exit Function
End Select
Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
'This second approach assumes you get the control ID each time the subclassing procedure is called.
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_ContextMenu
Local Ctl as DWord
Window Get ID hWnd TO Ctl
MsgBox Str$(Ctl)
Function = 0 : Exit Function
End Select
Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
'Which of the two you used depends on which value (CtrlID or hWnd) you want to work with.
'Compilable Example: (Jose Includes)
'In this example, subclassing is used to prevent the normal context menu from
'appearing when a textbox is right-mouse clicked - with multiple textboxes using
'the same subclassing procedure. An application might provide its own custom
'context menu. Right-click any box.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg As DWord, hTB1 As DWord, hTB2 as DWord, hTB3 as DWord, OldProc&
%ID_Control1 = 500 : %ID_COntrol2 = 501 : %ID_Control3 = 502
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
Control Add TextBox, hDlg, %ID_Control1, "TB1", 20,10,120,20
Control Add TextBox, hDlg, %ID_Control2, "TB2!", 20,40,120,20
Control Add TextBox, hDlg, %ID_Control3, "TB3!", 20,70,120,20
Control Handle hDlg, %ID_Control1 to hTB1
Control Handle hDlg, %ID_Control2 to hTB2
Control Handle hDlg, %ID_Control3 to hTB3
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_Control1), %GWL_WndProc, CodePTR(NewProc)) 'subclass
OldProc& = SetWindowLong(GetDlgItem(hDlg, %ID_Control2), %GWL_WndProc, CodePTR(NewProc)) 'subclass
OldProc& = SetWindowLong(GetDlgItem(hDlg, %ID_Control3), %GWL_WndProc, CodePTR(NewProc)) 'subclass
End Select
End Function
Function NewProc2(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'assumes handles are kept when the textboxes are generated
Select Case Msg
Case %WM_ContextMenu
Select Case hWnd
Case hTB1 : MsgBox "TB1"
Case hTB2 : MsgBox "TB2"
Case hTB3 : MsgBox "TB3"
End Select
Function = 0 : Exit Function
End Select
Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'gets control id each time the subclassing procedure is called
Select Case Msg
Case %WM_ContextMenu
Local Ctl as DWord
Window Get ID hWnd TO Ctl
MsgBox Str$(Ctl)
Function = 0 : Exit Function
End Select
Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
'gbs_00309
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm