Announcement

Collapse
No announcement yet.

Subclass in a box - questions

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

  • Subclass in a box - questions

    ' I'm toying with this sublcass method as a way to generalize controls so that I can use them more than once in the same or
    ' different programs. Prior to this, for some reason, I thought subclassing had to be one subclass procedure for one control
    ' only.
    ' Questions:
    ' 1. Can the subclass functions be in a DLL (Wondering about the scope of the CODEPTR function? My guess is not allowed.
    ' 2. If a subclass procedure has code that decides where to jump next, either the next field or three fields down the
    ' page, can the id's just simply be passed using Control Set User that is, at the moment using the Subclassing
    ' 3. Can the Set User be used to store STRPTR's or VARPTR's in case of variable data that might be needed in the subclass control
    ' that would be different for each control that might use the subclass.
    ' Any other utility uses that might be pointed out would be appreciated.
    '
    'Bob Mechler
    Code:
    'MESSAGE http://www.powerbasic.com/support/forums/Forum7/HTML/003030.html
    'FORUM:  Source Code
    'TOPIC:  Simple subclassing in a box
    'NAME:   Colin Schmidt, Member
    'DATE:   October 26, 2006 02:39 AM
    
    
    
    'SubClassInABox.bas
    'Demonstrate simple subclassing using just a few macros.
    'Key point is that it uses the internal %GWL_USERDATA storage of each
    'subclassed control so that you don't have to keep track of the original
    'WinProc value yourself. It is naturally thread safe and you may have
    'as many subclassed controls on as many different windows as you like.
    'Colin Schmidt, skyhawk76(at)yahoo.com
    
    ' Other portions from Kev Peel's Light Hoverbutton control (LabelProc) and a sample of a subclassed decimal textbox example
    ' from somewhere.
    '
    %USEMACROS = 1
    #INCLUDE "Win32API.inc"
    
    
    '-------------------------------------------------------------------------------
    'This is the box
    MACRO mSC_Set(phDlg, phCtl, pProc)
        SetWindowLong GetDlgItem(phDlg, phCtl), %GWL_USERDATA, _
            SetWindowLong(GetDlgItem(phDlg, phCtl), %GWL_WNDPROC, CODEPTR(pProc))
    END MACRO
    MACRO mSC_Kill(phCtl)
        SetWindowLong(GetDlgItem(CBHNDL, phCtl), %GWL_WNDPROC, _
            GetWindowLong(CBHNDL, %GWL_USERDATA))
    END MACRO
    MACRO mSC_OrgProc
        FUNCTION = CallWindowProc(GetWindowLong(phWnd, %GWL_USERDATA), phWnd, pdMsg, pWParam, pLParam)
    END MACRO
    'End of box
    '-------------------------------------------------------------------------------
    
    
    '-------------------------------------------------------------------------------
    'Example of using the box
    
    %ID_EXIT = 100: %IDC_TextBox  = 101: %IDC_TextBox1 = 102: %IDC_TextBox2 = 103: %IDC_TextBox3 = 104: %IDC_TextBox4 = 105
    %IDC_Notice   = 201: %IDC_Notice1  = 202: %IDC_Hint = 203
    %hf1 = 100
    GLOBAL TXT AS STRING,VKEY AS LONG
    
    FUNCTION PBMAIN
        LOCAL lhDlg AS DWORD
    
        DIALOG NEW 0, "SubClassInABox", , , 200, 190, %WS_MINIMIZEBOX OR %WS_SYSMENU TO lhDlg
        CONTROL ADD TEXTBOX, lhDlg, %IDC_TextBox, "", 10, 10, 75, 12,%ES_LEFT OR %WS_BORDER OR %WS_TABSTOP,%WS_EX_LEFT OR %WS_EX_CLIENTEDGE
        CONTROL ADD LABEL,   lhDlg, %IDC_Hint   , "Try pressing F6! or Enter ",86,10,100,12 
        CONTROL ADD TEXTBOX, lhDlg, %IDC_TextBox1, "", 10, 22, 75, 12,%ES_LEFT OR %WS_BORDER OR %WS_TABSTOP,%WS_EX_LEFT OR %WS_EX_CLIENTEDGE
        CONTROL ADD TEXTBOX, lhDlg, %IDC_TextBox2, "", 10, 34, 50, 12,%ES_RIGHT OR %WS_BORDER OR %WS_TABSTOP,%WS_EX_LEFT OR %WS_EX_CLIENTEDGE
        CONTROL SEND         lhDlg, %IDC_TextBox2, %EM_LIMITTEXT, 10, 0
        CONTROL ADD LABEL,   lhDlg, %IDC_Hint   , "Decimal <= 10 digits ",86,34,100,12 
        CONTROL ADD LABEL,   lhDlg, %IDC_Notice, STR$(%IDC_Notice), 10, 100, 75, 10,%SS_SIMPLE OR %SS_NOTIFY
        CONTROL ADD LABEL,   lhDlg, %IDC_Hint   , "<--Hover or click ",86,100,100,12 
        CONTROL ADD LABEL,   lhDlg, %IDC_Notice1, STR$(%IDC_Notice1), 10, 115, 75, 10,%SS_SIMPLE OR %SS_NOTIFY
        CONTROL ADD BUTTON,  lhDlg, %ID_EXIT, "&OK", 145, 150, 40, 14
        CONTROL ADD LABEL,   lhDlg, %IDC_Hint   , "<--Hover or click ",86,115,100,12 
    
        mSC_Set(lhDlg, %IDC_TextBox, TextBoxProc)
        mSC_Set(lhDlg, %IDC_TextBox2, MoneyInput_SC)
        mSC_Set(lhDlg, %IDC_Notice, LabelProc)
        mSC_Set(lhDlg, %IDC_Notice1, LabelProc)
    
        DIALOG SHOW MODAL lhDlg CALL MainProc
    
    END FUNCTION
    CALLBACK FUNCTION MainProc
        SELECT CASE AS LONG CBMSG
            CASE %WM_DESTROY
                mSC_Kill(%IDC_TextBox)
                mSC_Kill(%IDC_TextBox2)
                mSC_Kill(%IDC_Notice)
                mSC_Kill(%IDC_Notice1)
    
            CASE %WM_COMMAND
                SELECT CASE AS LONG CBCTL
                    CASE %IDOK
                       SetFocus GetNextDlgTabItem(CBHNDL,GetFocus(),0)
                    CASE %ID_EXIT
                       DIALOG END CBHNDL
                END SELECT
    
        END SELECT
    END FUNCTION
    FUNCTION Lookup (TXT AS STRING) AS LONG
    LOCAL lhDlg1 AS LONG
        DIALOG NEW 0, "Add something to the text",10 ,100 , 200, 195, %WS_MINIMIZEBOX OR %WS_SYSMENU TO lhDlg1
        CONTROL ADD TEXTBOX, lhDlg1, %hf1, TXT, 10, 10, 75, 10
        CONTROL ADD BUTTON, lhDlg1, %ID_EXIT, "&OK", 145, 150, 40, 14
        DIALOG SHOW MODAL lhDlg1, CALL MainProc1
    END FUNCTION
    CALLBACK FUNCTION MainProc1                          
        SELECT CASE AS LONG CBMSG
            CASE %WM_COMMAND
                SELECT CASE AS LONG CBCTL
                    CASE %ID_EXIT
                      SELECT CASE CBCTLMSG
                        CASE %BN_CLICKED
                          CONTROL GET TEXT CBHNDL,%HF1 TO TXT
                          DIALOG END CBHNDL
                      END SELECT    
                    CASE %HF1
                      SELECT CASE CBCTLMSG
                        CASE %EN_UPDATE
                          CONTROL GET TEXT CBHNDL,%HF1 TO TXT
                      END SELECT
                END SELECT
        END SELECT
    END FUNCTION
    
    FUNCTION MoneyInput_SC(BYVAL phWnd AS DWORD, BYVAL pdMsg AS DWORD, BYVAL pWParam AS DWORD, BYVAL pLParam AS LONG) AS LONG
    
      DIM  Dpnt  AS LOCAL LONG
      DIM hWnd   AS LOCAL DWORD
      DIM  Mlen  AS LOCAL LONG
      DIM  Tlen  AS LOCAL LONG
      DIM  Txt   AS LOCAL ASCIIZ * %MAX_PATH
      DIM  Value AS LOCAL CUX
    
      SELECT CASE pdMsg
        CASE %WM_CHAR      : IF pWParam < 32 THEN EXIT SELECT                   ' BkSpc, Tab, etc pass these on
                             IF pWParam > 57 THEN EXIT FUNCTION                 ' > "9" not legal
                             IF pWParam = 47 THEN EXIT FUNCTION                 ' "/" not legal
                             IF pWParam < 46 THEN EXIT FUNCTION                 ' < "." not legal
                             Tlen = GetWindowTextLength(phWnd)                  ' current text length
                             IF Tlen = 0 THEN EXIT SELECT                        ' anything goes here!
                             GetWindowText phWnd, Txt, %MAX_PATH                ' get current text
                             Dpnt = INSTR(Txt,".")                               ' find "."
                             IF pWParam = 46 THEN                               ' "." was input
                                 IF Dpnt > 0 THEN EXIT FUNCTION                  ' can't have 2
                               ELSEIF Dpnt > 0 THEN                              ' already working on decimal value
                                 IF Dpnt + 2 = Tlen THEN EXIT FUNCTION           ' can't have more than 2 places past decimal
                               ELSE                                              ' digits 0 -> 9
                                 Mlen = SendMessage(phWnd,%EM_GETLIMITTEXT,0,0) ' max length
                                 IF Tlen = Mlen-3 THEN EXIT FUNCTION             ' can't have more whole numbers than this
                             END IF                                              '
        CASE %WM_PASTE     : EXIT FUNCTION                                       ' bypass this
        CASE %WM_SETFOCUS  : GetWindowText phWnd, Txt, %MAX_PATH                ' strip out the comma's
                             Txt = REMOVE$(Txt,",")                              '
                             SetWindowText phWnd, Txt                           '
                             SendMessage phWnd, %EM_SETSEL, 0, -1               '
        CASE %WM_KILLFOCUS : GetWindowText phWnd, Txt, %MAX_PATH                ' reformat the value for display
                             Value = VAL(Txt)                                    '
                             Txt   = FORMAT$(Value, "0,.00")                     '
                             SetWindowText phWnd, Txt                           '
      END SELECT                                                                 '
                                                                                 '
                                                                                 '
      mSC_OrgProc
    
    END FUNCTION
    
    FUNCTION TextBoxProc(BYVAL phWnd AS DWORD, BYVAL pdMsg AS DWORD, BYVAL pWParam AS DWORD, BYVAL pLParam AS LONG) AS LONG
        SELECT CASE AS LONG pdMsg
            CASE %WM_KEYDOWN,%WM_SYSKEYDOWN
                CONTROL SET TEXT GetParent(phWnd), %IDC_Notice, STR$(pWParam)
                IF pWParam = %VK_F6 THEN
                  CONTROL GET TEXT GetParent(phWnd),%IDC_TextBox TO TXT
                  CALL Lookup(TXT)
                  CONTROL SET TEXT GetParent(phWnd),%IDC_TextBox1,TXT
                  CONTROL SET FOCUS GetParent(phWnd),%IDC_TextBox1
                END IF            
            CASE %WM_KEYUP
              IF pWParam = %VK_RETURN THEN 
                GetNextDlgTabItem(GetParent(phWnd),phWnd,0)
              END IF  
        END SELECT
        mSC_OrgProc
    END FUNCTION
    TYPE HB_DATA                            ' Custom data for the control
         zText        AS ASCIIZ * 250       ' Display text
         cText        AS DWORD              ' Text color
         cBack        AS DWORD              ' Back color
         cHovTxt      AS DWORD              ' Mouse over text color
         cHovBk       AS DWORD              ' Mouse over back color
         cFocus       AS DWORD              ' Focus rectangle color
         bHasTxtClr   AS BYTE               ' Nonzero if text color is valid
         bHasBkClr    AS BYTE               ' Nonzero if back color is valid
         bIsOver      AS BYTE               ' Mouse is hovering over
         bIsDown      AS BYTE               ' Mouse button is down
         bTimer       AS BYTE               ' Nonzero for timer
         bCheck       AS BYTE               ' Nonzero if checked
         lfFont       AS LOGFONT            ' Font style
    END TYPE
    
    FUNCTION LabelProc(BYVAL phWnd AS DWORD, BYVAL pdMsg AS DWORD, BYVAL pWParam AS DWORD, BYVAL pLParam AS LONG) AS LONG
    DIM pt AS POINTAPI,rc AS RECT, i AS LONG
    STATIC fda AS LONG
    STATIC fdaover AS LONG
    DIM CID AS LONG
    CID = GetDlgCtrlId(phWnd)
        SELECT CASE AS LONG pdMsg
            CASE %WM_LBUTTONDOWN
                SetWindowText GetParent(phWnd), "Button Down " + STR$(CID)
            CASE %WM_LBUTTONUP
                SetWindowText GetParent(phWnd), "Button Up " + STR$(CID)
            CASE %WM_MOUSEMOVE
                 ' Activate temporary timer...
                 'fda = GetWindowLong(phWnd, 0)
                 IF fda = 0 THEN
                    fda = 1
                    SetTimer phWnd, 100, 10, 0
                 END IF
            CASE %WM_TIMER
                 ' This timer is temporarily set when the mouse moves over the control
                 ' If the mouse moves off, the timer is destroyed. It is done this way for performance reasons...
                 'fda = GetWindowLong(phWnd, 0)
                 GetCursorPos pt
                 GetWindowRect phWnd, rc
                 ' Send multiple signals to parent if button has spin style...
                 i = PtInRect(rc, pt.x, pt.y)
                 IF (i = 0) AND (fda = 1) THEN
                    KillTimer phWnd, 100
                    fda = 0
                 END IF
                 IF (i <> fdaover) THEN
                    fdaover = IIF&(fdaover, 0, 1)
                    'RedrawWindow phWnd, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
                 END IF
                 IF fdaover THEN
                   CONTROL SET TEXT GetParent(phWnd),CID,""
                   CONTROL SET TEXT GetParent(phWnd),CID,STR$(CID)
                   CONTROL SET COLOR GetParent(phWnd),CID,%RED,-1
                   RedrawWindow phWnd, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
                 ELSE
                   CONTROL SET TEXT GetParent(phWnd),CID,""
                   CONTROL SET TEXT GetParent(phWnd),CID,STR$(CID)
                   CONTROL SET COLOR GetParent(phWnd),CID,%BLACK,-1
                   RedrawWindow phWnd, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
                 END IF
        END SELECT
        mSC_OrgProc
    END FUNCTION

  • #2
    That looks (looks) fine to me, assuming "pHCtl" is a control ID and not a handle. (GetDlgItem() requires a control ID not a handle as the second parameter)

    About the only thing I would suggest changing is where you retain the "old" window procedure address.

    Using GWL_USERDATA for this means you can't use it for anything else. You might want to think about storing that as a "window property" using something akin to ...

    Code:
    $PROP_OLD_WNDPROC  = "Old_WndProc" 
    .....
    MACRO mSC_Set(phDlg, phCtl, pProc)
     MACROTEMP szProp 
     DIM szProp AS ASCIIZ * 48 
        SetWindowLong GetDlgItem(phDlg, phCtl), %GWL_USERDATA, _
            SetWindowLong(GetDlgItem(phDlg, phCtl), %GWL_WNDPROC, CODEPTR(pProc))
         szProp = $PROP_OLD_WNDPROC
         SetProp  GetDlgItem(phDlg, phCtrl),  szProp, pProc
             
    END MACRO
    In your subclass procedure you can call the original wndProc with
    Code:
      szProp = $PROP_OLD_WNDPROC
      FUNCTION = CallWindowProc (GetProp( hwnd, szProp), hWnd, wMsg, wParam, lparam) )
    Then again, you could use window properties for the "other" stuff reserving GWL_USERDATA for your old window procedure. Style thing mostly.

    Note that if this is a dialog DWL_USER is a available too.

    Note also that if this is DDT I'm not sure either GWL_USERDATA or DWL_USER are available for your use, although the DDT adds the 'CONTROL SET USER' values for miscallaneous window data.

    MCM
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      Control Set/get User

      Just a quick note in reply to Michael's question, when using this 'Subclass in a Box' system for controls it does not interfere with DDT's CONTROL SET/GET USER function.

      Regards,
      Colin Schmidt

      Comment

      Working...
      X