Subclassing to allow custom textbox context menu

[Gary Beene]

Well, I thought this would be an easy fix - using subclassing to allow the use of a custom right mouse context popup menu.

But it doesn't seem to work. For that matter, the replacement procedure doesn't even seem to get all the messages.

Is it obvious what I've done wrong?

#Compile Exe
#Dim All
#Include "win32api.inc"
Global hDlg As Dword, OrigTextBoxProc&, hContext As Dword
%ID_TextBox = 500 : %ID_Label = 700
Function PBMain () As Long
   Dialog New Pixels, 0, "Subclassing",300,300,200,100, %WS_OverlappedWindow To hDlg
   Control Add Label, hDlg, %ID_Label, "label",20,10,100,20
   Control Add TextBox, hDlg, %ID_TextBox, "my text",20,30,100,20, %WS_Border Or %SS_Notify Call TextBoxProc
   SubClassTextBox
   AddMenu
   Dialog Show Modal hdlg
End Function

CallBack Function TextBoxProc
   MsgBox "Not supposed to be here!"   'should not see this message
End Function

Sub SubClassTextBox
   OrigTextBoxProc& = SetWindowLong(GetDlgItem(hDlg, %ID_TextBox), %GWL_WndProc, CodePtr(NewTextBoxProc))
End Sub

Sub AddMenu()   'Context Popup -------------------------
    Menu New PopUp To hContext
    Menu Add String, hContext, "One", 201,  %MF_Enabled
    Menu Add String, hContext, "Two", 202, %MF_Enabled
End Sub

Function NewTextBoxProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Control Set Text hDlg, %ID_Label, Str$(Msg)      'any message should cause this to work
   Select Case msg
      Case %WM_ContextMenu
         TrackPopupMenu hContext, %TPM_LEFTALIGN, 0, 0, 0, hDlg, ByVal 0
         Function = 1
      Case Else
         CallWindowProc(OrigTextBoxProc&, hWnd, Msg, wParam, lParam)
   End Select

I tried a couple other subclassing test cases and none of them worked. I must be overlooking something basic (no pun intended) in the subclassing code!

[Michael Mattias]

%SS_Notify is not a valid style for a text box.

Also I think you are supposed to include all relevant styles ... if you specify any, you have to specify all.. yes that's what the help says for CONTROL ADD TEXTBOX:

Custom style values replace the default values. That is, they are not additional to the default style values - your code must specify all necessary primary and extended style parameters

I know you need WS_CHILD and WS_VISIBLE, and you probably want WS_TABSTOP and WS_GROUP, too.

Try again after fixing up your style parameters.

MCM

[Gary Beene]

Same result.

   style& = %WS_Border Or %WS_Child Or %WS_TabStop Or %ws_group Or %WS_Visible Or %ES_Left Or %ES_AutoHScroll
   extstyle& = %WS_Ex_ClientEdge Or %WS_Ex_Left
   Control Add TextBox, hDlg, %ID_TextBox, "my text",20,30,100,20, style&, extstyle& Call TextBoxProc

I added back in all of the default values - although, I didn't think the styles would have any effect on subclassing? Is there some interaction possible?

[Michael Mattias]

Try it without using the DDT control-level callbacks. (CALL option in 'CONTROL ADD controlname' )

I have done this before (customize the edit control's default context menu), but that was all done SDK-style, which does not have 'control level callbacks.'

And for the rare times I use DDT syntax, I gave up using control level callbacks a long time ago so I really don't understand how those are implemented.

[Michael Mattias]

>I didn't think the styles would have any effect on subclassing

Using invalid styles on any control can 'make a weird.'

[Gary Beene]

Using the dialog callback, not control callback, I get the same result - the custom context menu does not appear.

I'm sounding like a broken record.

The label content changes from code within the new textbox procedure, so I know messages are being received by the new procedure. But there appears to be no WM_ContextMenu message being received by the new procedure.

#Compile Exe
#Dim All
#Include "win32api.inc"
Global hDlg As Dword, OrigTextBoxProc&, hContext As Dword
%ID_TextBox = 500 : %ID_Label = 700
Function PBMain () As Long
   Local style&, extstyle&
   Dialog New Pixels, 0, "Subclassing",300,300,200,100, %WS_OverlappedWindow To hDlg
   Control Add Label, hDlg, %ID_Label, "label",20,10,100,20

   style& = %WS_Border Or %WS_Child Or %WS_TabStop Or %ws_group Or %WS_Visible Or %ES_Left Or %ES_AutoHScroll
   extstyle& = %WS_Ex_ClientEdge Or %WS_Ex_Left
   Control Add TextBox, hDlg, %ID_TextBox, "my text",20,30,100,20, style&, extstyle&

   SubClassTextBox
   AddMenu

   Dialog Show Modal hdlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
 Select Case Cb.Msg
    Case %WM_Command
       Control Set Text hdlg, %ID_Label, "old" + Str$(Cb.Msg)  'just to see if anything gets here
 End Select
End Function

Sub SubClassTextBox
   OrigTextBoxProc& = SetWindowLong(GetDlgItem(hDlg, %ID_TextBox), %GWL_WndProc, CodePtr(NewTextBoxProc))
End Sub

Sub AddMenu()   'Context Popup -------------------------
    Menu New PopUp To hContext
    Menu Add String, hContext, "One", 201,  %MF_Enabled
    Menu Add String, hContext, "Two", 202, %MF_Enabled
End Sub

Function NewTextBoxProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Control Set Text hDlg, %ID_Label, "new" + Str$(Msg)      'any message should cause this to work
   Select Case msg
      Case %WM_ContextMenu
         Control Set Text hDlg, %ID_Label, "bingo"
         TrackPopupMenu hContext, %TPM_LEFTALIGN, 0, 0, 0, hDlg, ByVal 0
      Case Else
         CallWindowProc(OrigTextBoxProc&, hWnd, Msg, wParam, lParam)
   End Select
End Function

[Chris Boss]

Big error in your subclass procedure.

CallWindowProc(OrigTextBoxProc&, hWnd, Msg, wParam, lParam)

must be:

FUNCTION=CallWindowProc(OrigTextBoxProc&, hWnd, Msg, wParam, lParam)

If you don't return the value of the original window procedure call, then you cause serious problems, because the return value is significant for many messages.

[Gary Beene]

Chris, thanks!

That cleared it up.

A person can look at code for hours and yet the simplest thing can be there in plain sight!

[Gary Beene]

Chris,

But wait - do I always have to execute the line:

Function = ...

Or just in the "Case Else" section as I did?

I'd read your comment to mean always, not just when I don't handle an incoming message.

My example did work with it only in the "Case Else" section of code.

[Chris Boss]

The return value of a window procedure (or subclass procedure) has significance.

When you pass on the message to another routine (ie. subclass procedure calls CallWindowProc) always get the return value (FUNCTION=).

When you process a message you must read the API docs to see what significance the return value has. In some cases you always return zero, so not critical, but others the return value is critical.

Also when you process a message you must determine whether you want to allow the default processing to be done also. In a subclass procedure, if you want the default processing as well, let the message get passed to the CallWindowProc function call. In a window procedure (when you create the class yourself) let the message be passed to the DefWindowProc call.

If you don't want the default processing of the message, then in the select case structure do the following:

CASE %WM_SomeMessage
' do something
FUNCTION=SomeValue&
EXIT FUNCTION

Now make sure when you do this though, that the deafult processing is not necessary for proper functioning.

[Chris Boss]

A better layout for your subclass routine would be like this:

FUNCTION NewTextBoxProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
     'don't do things like this:
     CONTROL SET TEXT hDlg, %ID_Label, "new" + STR$(Msg)      'any message should cause this to work
     ' because many messages are processed which you may not be aware of and some messages may not like
     ' certain things done during the message processing
     ' all code before the SELECT CASE should be safe code which won't affect other windows
     ' like DIM variables, math code, some safe API calls
     ' just try to do the bare minimum of stuff before the select case
   SELECT CASE msg
      CASE %WM_ContextMenu
         CONTROL SET TEXT hDlg, %ID_Label, "bingo"
         TrackPopupMenu hContext, %TPM_LEFTALIGN, 0, 0, 0, hDlg, BYVAL 0
         FUNCTION=0
         EXIT FUNCTION
      CASE ELSE
   END SELECT
   FUNCTION = CallWindowProc(OrigTextBoxProc&, hWnd, Msg, wParam, lParam)
END FUNCTION

I do a lot of subclassing and write a lot of custom controls so I have a lot of experience with writing subclassing and window procedures. Its best to follow safe ways of coding these to prevent problems.

[Gary Beene]

Chris,

I, on the other hand, have used subclassing only a few times, so I appreciate the advice and will take it to heart.

[Gary Beene]

<deleted>

[Edwin Knoppert]

Function NewTextBoxProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Local R As RECT
    Local nItem As Long

'   Control Set Text hDlg, %ID_Label, "new" + Str$(Msg)      'any message should cause this to work
   Select Case msg
      Case %WM_ContextMenu
         Control Set Text hDlg, %ID_Label, "bingo"
         
         Local x As Long
         Local y As Long
         
         x = CInt( LoWrd( lParam ) )
         y = CInt( HiWrd( lParam ) )
         If x < 0 And y < 0 Then
         
            GetWindowRect( hWnd, R )
            
            x = R.nLeft + ( ( R.nRight - R.nLeft ) / 2 )
            y = R.nTop + ( ( R.nBottom - R.nTop ) / 2 )
         
         End If
         
         nItem = TrackPopupMenu( hContext, %TPM_LEFTALIGN Or %TPM_RETURNCMD, x, y, 0, hDlg, ByVal 0 )
         If nItem Then
            MsgBox Str$( nItem ), %MB_TASKMODAL
         End If
         
         Exit Function
         
      Case Else
   End Select


Function = CallWindowProc(OrigTextBoxProc&, hWnd, Msg, wParam, lParam)


End Function