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)
=================================
Comment