Announcement

Collapse
No announcement yet.

Subclassing to allow custom textbox context menu

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Subclassing to allow custom textbox context menu

    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?

    Code:
    #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!
    Last edited by Gary Beene; 22 Apr 2009, 09:44 AM.

  • #2
    %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
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      Same result.

      Code:
         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?

      Comment


      • #4
        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
        Tal Systems (retired)
        Port Washington WI USA
        [email protected]
        http://www.talsystems.com

        Comment


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

          Using invalid styles on any control can 'make a weird.'
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment


          • #6
            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.

            Code:
            #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
            Last edited by Gary Beene; 22 Apr 2009, 10:49 AM.

            Comment


            • #7
              Big error in your subclass procedure.

              Code:
              CallWindowProc(OrigTextBoxProc&, hWnd, Msg, wParam, lParam)
              must be:

              Code:
              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.
              Chris Boss
              Computer Workshop
              Developer of "EZGUI"
              http://cwsof.com
              http://twitter.com/EZGUIProGuy

              Comment


              • #8
                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!

                Comment


                • #9
                  Chris,

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

                  Code:
                  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.

                  Comment


                  • #10
                    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
                    Computer Workshop
                    Developer of "EZGUI"
                    http://cwsof.com
                    http://twitter.com/EZGUIProGuy

                    Comment


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

                      Code:
                      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.
                      Chris Boss
                      Computer Workshop
                      Developer of "EZGUI"
                      http://cwsof.com
                      http://twitter.com/EZGUIProGuy

                      Comment


                      • #12
                        Chris,

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

                        Comment


                        • #13
                          <deleted>
                          Last edited by Gary Beene; 22 Apr 2009, 04:39 PM.

                          Comment


                          • #14
                            Code:
                            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
                            hellobasic

                            Comment

                            Working...
                            X