Subclass in a box - questions

[BOB MECHLER]

' 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

'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

[Michael Mattias]

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

$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

  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

[Colin Schmidt]

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