Subclassing Controls Using ComCtl32.dll version 6

[Jules Marchildon]

'------------------------------------------------------------------------------
' reference... http://msdn2.microsoft.com/en-us/library/bb773183(VS.85).aspx
' Excerpt:
'   "Subclassing Controls Using ComCtl32.dll version 6
'    ComCtl32.dll version 6 supplied with Windows XP contains four functions
'    that make creating subclasses easier and eliminate the disadvantages previously
'    discussed. The new functions encapsulate the management involved with multiple
'    sets of reference data, therefore the developer can focus on programming
'    features and not on managing subclasses."
'------------------------------------------------------------------------------
#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"
#INCLUDE "COMMCTRL.INC"
#INCLUDE "PBForms.INC"

%IDD_DIALOG1  =  101
%IDC_TEXTBOX1 = 1001
%IDC_BUTTON1  = 1002

DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG

'---Note: initialize InitCommonControlsEx() to use these...
DECLARE FUNCTION SetWindowSubclass LIB "COMCTL32" ALIAS "SetWindowSubclass" _
                    ( _
                    BYVAL hWnd AS DWORD, _
                    BYVAL pfnSubclass AS DWORD, _
                    BYVAL uIdSubclass AS LONG, _
                    BYVAL dwRefData AS LONG _
                    ) AS DWORD
DECLARE FUNCTION GetWindowSubclass LIB "COMCTL32" ALIAS "GetWindowSubclass"_
                    ( _
                    BYVAL hWnd AS DWORD, _
                    BYVAL pfnSubclass AS DWORD, _
                    BYVAL uIdSubclass AS LONG, _
                    BYVAL pdwRefData AS DWORD PTR _
                    ) AS DWORD
DECLARE FUNCTION RemoveWindowSubclass LIB "COMCTL32" ALIAS "RemoveWindowSubclass"_
                    ( _
                    BYVAL hWnd AS DWORD, _
                    BYVAL pfnSubclass AS DWORD PTR, _
                    BYVAL uIdSubclass AS DWORD _
                    ) AS DWORD
DECLARE FUNCTION DefSubclassProc LIB "COMCTL32" ALIAS "DefSubclassProc"_
                    ( _
                    BYVAL hWnd AS DWORD, _
                    BYVAL uMsg AS LONG, _
                    BYVAL WPARAM AS LONG, _
                    BYVAL LPARAM AS LONG _
                    ) AS DWORD
'---

'------------------------------------------------------------------------------
' All this subclass procedure does is remove the DLGC_HASSETSEL flag
' from the return value of the WM_GETDLGCODE message.
' credits: Original posted by oldnewthing, adapted to work with PBWIN804
'------------------------------------------------------------------------------
FUNCTION RemoveHasSetSelSubclassProc _
           ( _
            BYVAL hWnd AS DWORD, _
            BYVAL uiMsg AS LONG, _
            BYVAL wParam AS LONG, _
            BYVAL lParam AS LONG, _
            BYVAL uIdSubclass AS DWORD, _
            BYVAL dwRefData AS DWORD PTR _
            ) AS LONG

    SELECT CASE (uiMsg)

        CASE %WM_NCDESTROY
            CALL RemoveWindowSubclass(hwnd, CODEPTR(RemoveHasSetSelSubclassProc),uIdSubclass)

        CASE %WM_GETDLGCODE
            FUNCTION = DefSubclassProc(hwnd, uiMsg, wParam, lParam) AND(NOT(%DLGC_HASSETSEL))
            EXIT FUNCTION

    END SELECT

    FUNCTION = DefSubclassProc(hwnd, uiMsg, wParam, lParam)
    'reference... http://blogs.msdn.com/oldnewthing/archive/2003/11/11/55653.aspx
    ' Excerpt:
    '  "Preventing edit control text from being autoselected in a dialog box
    '   By default, when the user TABs to an edit control in a dialog box,
    '   the entire contents of the edit control are autoselected.
    '   This occurs because the edit control responds with the DLGC_HASSETSEL
    '   flag in response to the WM_GETDLGCODE message.
    '   To prevent it from happening, remove that flag."

END FUNCTION

'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
    PBFormsInitComCtls( %ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR %ICC_INTERNET_CLASSES )
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION

'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()

    STATIC hEdit AS DWORD

    SELECT CASE AS LONG CBMSG

        CASE %WM_INITDIALOG
            hEdit = GetDlgItem(CBHNDL,%IDC_TEXTBOX1)
            CALL SetWindowSubclass(hEdit,CODEPTR(RemoveHasSetSelSubclassProc), 0, 0)

        CASE %WM_COMMAND
            SELECT CASE AS LONG CBCTL
                CASE %IDCANCEL
                    DIALOG END CBHNDL
                    FUNCTION = 1
            END SELECT
    END SELECT
END FUNCTION

'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG

    LOCAL lRslt AS LONG
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "Subclassing", 180, 106, 292, 181, %WS_POPUP OR _
        %WS_BORDER OR %WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR _
        %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR _
        %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
        %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
        OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg

    CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "Subclassed Editbox", 48, 40, 176, 16
    CONTROL ADD BUTTON,  hDlg, %IDCANCEL, "Quit", 104, 88, 72, 24

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

    FUNCTION = lRslt
END FUNCTION