Tweet
I'm the guy that points people who ask about Subclassing to the Sample folder for a good example. Now I need subclassing help {sigh}.
I want to have multiple Textboxes to use the same Subclass but am unable to tell which TB "calls" the SC. See Function SubClassProc in the example. The CTL Msgbox never gets hit. Been trying different stuff for ... well, you know how long.
'
=================================
When your only tool is a hammer,
everything looks like a nail.
(FREDH - Salon's Table Talk)
=================================
I want to have multiple Textboxes to use the same Subclass but am unable to tell which TB "calls" the SC. See Function SubClassProc in the example. The CTL Msgbox never gets hit. Been trying different stuff for ... well, you know how long.
'
Code:
'Example of subclassing multiple textboxes
'PBWIN 9.01 - WinApi 05/2008 - XP Pro SP3
#Dim All
#Compile Exe
#Optimize SPEED
#Debug Display On'off for production code
#Include "WIN32API.INC"
#Include "COMDLG32.INC"
#Include "InitCtrl.inc"
'
Global hdlg As Dword
Global g_TB_Id(), g_TB_Handle() As Dword
%Id_Exit_Btn = 1000
'
Macro Common_Locals 'Macro easier than retyping and maintains coding consistency
Global Dlg_hght, Dlg_Wd As Long 'Global in case want to use in Controls
Local spcr, Stile, Row, col, ht, wd, Longest,ctr, ln, ln1, i As Long
Local l, s As String
Local hfont As Dword
End Macro
'
CallBack Function PBMain_Dialog_Processor
Common_Locals
Select Case CbMsg 'This is TO determine the message TYPE
'
Case %WM_INITDIALOG'<- Initialiaton when the program loads
'--------------------------------------------------------------
' %WM_INITDIALOG is sent right before the dialog is shown.
' A good place to initiate variables and controls, etc.
' Let's Subclass the TextBox and store the returned pointer
' to the original TextBox procedure with DIALOG SET USER.
'--------------------------------------------------------------
Local hEdit, oldProc As Dword
'dunno why but this is needed FIRST
Control Handle hdlg, g_TB_Id(3) To hEdit
oldProc = SetWindowLong(hEdit, %GWL_WNDPROC, CodePtr(SubClassProc))
Dialog Set User CB.Hndl, 1, oldProc '<<< only 8 spaces avl
'
' Create Handles For subclassing All textboxes
For ctr = LBound(g_TB_Id()) To UBound(g_TB_Id())
Control Handle hdlg, g_TB_Id(ctr) To hEdit
oldProc = SetWindowLong(hEdit, %GWL_WNDPROC, CodePtr(SubClassProc))
g_TB_Handle(ctr) = OldProc
Control Set Text hdlg, g_tb_id(ctr), Using$("#, ", g_tb_Handle(ctr)) 'show handles
Next ctr
Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes
'
Case %WM_COMMAND 'This processes command messages
Select Case CbCtl
Case %Id_Exit_Btn
Select Case CbCtlMsg
Case 0
Dialog End CbHndl 'Applikation beenden
End Select
End Select
End Select
End Function
'
'====================================================================
Function SubClassProc(ByVal hWnd As Dword, ByVal wMsg As Dword, _
ByVal wParam As Dword, ByVal lParam As Long) As Long
'--------------------------------------------------------------------
' SubClass procedure
'------------------------------------------------------------------
Local lRes, oldProc As Dword
Local ctl As Long
'------------------------------------------------------------------
' Messages shall normally be passed on to the original procedure
' with CallWindowProc for processing, which is why we stored the
' return value from SetWindowLong in the dialog's USER memory.
' However, it is perfectly ok to break some messages by not
' passing them on to the original procedure - see below.
' We'll use the GetParent API call to get parent dialog's handle.
'------------------------------------------------------------------
Dialog Get User hdlg, 1 To oldProc
If oldProc = 0 Then Exit Function 'not assigned
'find intercepted control id
ctl = lParam 'Hi(Dword, wparam) 'not Lo(Dword, wparam)
Select Case ctl
Case g_tb_id(2), g_tb_id(10)
? "hit"
Exit Function
End Select
'------------------------------------------------------------------
Select Case As Long wMsg
'------------------------------------------------------------------
'
' Case %Wm_command
' Exit Function
'
Case %WM_GETDLGCODE
' TextBoxes have a tendency to select all text when they receive
' focus. We can change this behaviour by altering the return
' value from CallWindowProc under %WM_GETDLGCODE, like follows:
lRes = CallWindowProc (oldProc, hWnd, wMsg, wParam, lParam)
If (lRes And %DLGC_HASSETSEL) = %DLGC_HASSETSEL Then
lRes = lRes Xor %DLGC_HASSETSEL
Function = lRes
Exit Function
End If
'------------------------------------------------------------------
Case %WM_CHAR ' we can break some keys here
' Note: Must use the VkKeyScan API to get correct scan code.
Select Case Lo(Byte, VkKeyScan(wParam))
Case %VK_SPACE ' Let's break the Space bar
MsgBox "Spaces are not allowed here!", _
%MB_TASKMODAL, "SubClass message"
Exit Function
End Select
'------------------------------------------------------------------
Case %WM_PASTE ' just for fun - break Paste.
' Try to paste something in the TextBox and see what happens.
' Remove the next 2 lines to make it work again.
MsgBox "Paste is not allowed here!", _
%MB_TASKMODAL, "SubClass message"
Exit Function
End Select
'------------------------------------------------------------------
' Pass on messages to original control procedure
Function = CallWindowProc(oldProc, hWnd, wMsg, wParam, lParam)
End Function
'
Function PBMain
Common_Locals
Local hEdit, oldProc As Dword
ctr = 32
ReDim g_TB_Id(1 To ctr), g_TB_Handle(1 To ctr)
For ctr = LBound(g_TB_Id()) To UBound(g_TB_Id())
g_TB_Id(ctr) = 1000 + ctr 'assign ids
Row = Row + ht + spcr
Next ctr
Stile = Stile Or %WS_CAPTION
Stile = Stile Or %WS_SYSMENU
Stile = Stile Or %WS_THICKFRAME
Stile = Stile Or %WM_HELP
Stile = Stile Or %WS_Border 'doesn't do anything
Dlg_hght = 250
Dlg_Wd = 220
Dialog New Pixels, hdlg, "Multi Textbox Subclass Demo", , , Dlg_Wd, Dlg_Hght, Stile To hdlg 'centered
Font New "Consolas", 10 To hfont
spcr = 5
Row = 10
col = 10
Wd = 45
Ht = 20
For ctr = LBound(g_TB_Id()) To UBound(g_TB_Id())
Control Add TextBox, hdlg, g_TB_Id(ctr), Using$("#,### ", g_tb_Handle(ctr)), _
Col, Row, wd, ht
Control Set Font hdlg, g_TB_Id(ctr), hfont
Row = Row + ht + spcr
If Row > Dlg_hght - ht - 25 Then 'past bottom - next column
Row = 10
Col = Col + Wd + spcr
If col > Dlg_Wd Then Exit For 'no more room at the inn
End If
Next ctr
'
ht = 25
Wd = Dlg_Wd - 20
Col = 10 'center
Row = Dlg_hght - Ht - 2 'Just off bottom
Control Add Button, hdlg, %Id_Exit_Btn, "Abandon Ship", col, row, Wd, Ht
Dialog Show Modal hDlg Call PBMain_Dialog_Processor
End Function 'Applikation befursmucken
'
When your only tool is a hammer,
everything looks like a nail.
(FREDH - Salon's Table Talk)
=================================
' ing yourself .... 
Comment