Announcement

Collapse
No announcement yet.

Custom Control question based on superclassing an empty container

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

  • Custom Control question based on superclassing an empty container

    I am learning how to build a custom control based on superclassing thinking I will eventually package the control into a dll . My first attempt superclasses the standard editbox and that method works + I am able to subclass my custom control.

    My 2nd test doesn't work and I'm not sure why. My 2nd method creates a superclassed custom control with an empty container (based on an example posted long ago by Dominic - link is shown in the sample code below). That 2nd method works well until you try to subclass the custom control; when you try subclass the custom control the editbox doesn't display and the debugger is called if you try to click on a button control that I added to the control.

    Does anyone know why I can't subclass a superclassed custom control when that superclassed custom control is based on an empty container? I hope I'm just missing something simple.

    You can fix the program below by commenting out this line of code:

    Code:
    oldproc = SetWindowLong(hLookup, %GWL_WNDPROC, CODEPTR(LookupProc))
    You can break the program by including that same line in the program. Thanks in advance.

    Ken Levin

    Code:
    'based on an example posted by Dominic at:
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/7792-superclass-new-control?t=7539&highlight=container+custom+control
    '
    'while trying to create a custom control using superclassing I discovered I could not subclass my control if the control is created with
    'a superclassed empty container (similar to what Dominic demonstrated in the above link).
    '
    'in a different test (different program not posted here) I didn't have a problem subclassing a supeclassed custom control if that superclass
    'is based on a standard window's control (like an editbox). I am uncertain why one method works and the other does not.
    '
    'to test: comment out the line of code that starts with: oldproc =  to make the program work and leave it in to break the program
    
    #DIM ALL
    #REGISTER NONE
    #COMPILE EXE
    
    #INCLUDE "WIN32API.INC"
    
    '=========================== [ Control Identifiers ] ===========================
    
    ' Form2
    %IDD_FORM2                                  = 1000
    %IDC_FORM2_LOOKUP1                          = 1001
    %IDC_FORM2_TEXTBTN1                         = 1002
    %idc_control = %WM_USER+1000
    %idc_button = %WM_USER + 1001
    %idc_edit = %WM_USER + 1002
    %ControlExtraData = 5
    $ControlClassName ="Lookup"
    
    
    GLOBAL oldproc AS DWORD PTR
    GLOBAL oldprocbtn AS DWORD PTR
    GLOBAL  ghInstance AS DWORD
    GLOBAL hLookup AS DWORD
    GLOBAL hEdit AS DWORD
    GLOBAL hBtn AS DWORD
    GLOBAL gClassName AS STRING 'global kinda safe as long as user doesn't call registercontrol 2x
    
    '====================== [ Global Variable Declarations ] =======================
    '-------------------------------------------------------------------------------
    '
    ' PROCEDURE: WinMain
    ' PURPOSE:   Program entry point, calls initialization function, processes
    '            message loop.
    '
    '-------------------------------------------------------------------------------
    
    FUNCTION WINMAIN _
      ( _
      BYVAL hInstance     AS LONG, _        ' handle of current instance
      BYVAL hPrevInstance AS LONG, _        ' handle of previous instance(not used in Win32)
            BYVAL pszCmdLine    AS ASCIIZ PTR, _  ' address of command line
      BYVAL nCmdShow      AS LONG _         ' show state of window
      ) AS LONG
    
      LOCAL szClassName   AS ASCIIZ * %MAX_PATH   ' class name
      LOCAL twcx          AS WNDCLASSEX           ' class information
      LOCAL tmsg          AS tagMsg               ' message information
      LOCAL hWnd          AS DWORD                ' handle of main window
      LOCAL lret AS LONG
    
      ' Save the handle of the application instance
      ghInstance = hInstance
    
      szClassName        = "Form2_Class"
      twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
      twcx.style         = %CS_DBLCLKS                                ' class styles
      twcx.lpfnWndProc   = CODEPTR(Form2_WndProc)                     ' address of window procedure used by class
      twcx.cbClsExtra    = 0                                          ' extra class bytes
      twcx.cbWndExtra    = 0                                          ' extra window bytes
      twcx.hInstance     = ghInstance                                 ' instance of the EXE/DLL that is registering the window
      twcx.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of class icon
      twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
      twcx.hbrBackground = %COLOR_BTNFACE + 1                         ' brush used to fill background of window's client area
      twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
      twcx.lpszClassName = VARPTR(szClassName)                        ' class name
      twcx.hIconSm       = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of small icon shown in caption/system Taskbar
      IF ISFALSE RegisterClassEx(twcx) THEN
        FUNCTION = %FALSE
        EXIT FUNCTION
      END IF
    
     ' Register custom control
     lret =  RegisterLookup()
       ' Create the Form2 window (main program window)
       hWnd = CreateWindowEx(%WS_EX_WINDOWEDGE, _                                          ' extended styles
                            "Form2_Class", _                                              ' class name
                            "Enter numbers only in editbox", _                                                  ' caption
                            %WS_OVERLAPPEDWINDOW OR %WS_VISIBLE, _                        ' window styles
                            70, 94, _                                                     ' left, top
                            360, 178, _                                                   ' width, height
                            %NULL, %NULL, _                                               ' handle of owner, menu handle
                            ghInstance, BYVAL %NULL)                                      ' handle of instance, creation parameters
      ' If window could not be created, return "failure"
      IF ISFALSE hWnd THEN
        FUNCTION = %FALSE
        EXIT FUNCTION
      END IF
    
      ' Make the window visible; update its client area
      ShowWindow hWnd, %SW_SHOW
      UpdateWindow hWnd
    
      ' Main message loop of program.
      ' Acquire and dispatch messages until a WM_QUIT message is received.
      WHILE ISTRUE GetMessage(tmsg, BYVAL %NULL, 0, 0)
        IF ISFALSE IsDialogMessage(hWnd, tmsg) THEN
          TranslateMessage tmsg
          DispatchMessage tmsg
        END IF
      WEND
    
      FUNCTION = tmsg.wParam
    
    END FUNCTION
    
    '-------------------------------------------------------------------------------
    '
    ' PROCEDURE: Form2_WndProc
    ' PURPOSE:   Processes messages for the Form2 window.
    '
    '-------------------------------------------------------------------------------
    
    FUNCTION Form2_WndProc _
      ( _
      BYVAL hWnd    AS DWORD, _ ' window handle
      BYVAL uMsg    AS DWORD, _ ' type of message
      BYVAL wParam  AS DWORD, _ ' first message parameter
      BYVAL lParam  AS LONG _   ' second message parameter
      ) AS LONG
    
      LOCAL hWndChild   AS DWORD    ' handle of child window
      LOCAL hFont       AS DWORD    ' handle of font used by parent
      LOCAL lret AS LONG
    
      SELECT CASE uMsg
        CASE %WM_COMMAND
    
          SELECT CASE LOWRD(wParam)
           CASE %IDC_button
                IF HIWRD(wParam) = %BN_CLICKED THEN
    
                END IF
            CASE %IDOK
              IF HIWRD(wParam) = %BN_CLICKED THEN
                PostMessage hWnd, %WM_CLOSE, 0, 0
              END IF
    
          END SELECT
    
        CASE %WM_ACTIVATE
    
        CASE %WM_DESTROY
          IF oldproc  THEN  'remove subclass for control
                    SetWindowLong hLookup, %GWL_WNDPROC, oldProc
          END IF
    
           deleteLookup(hLookup) 'remove control
           UnRegisterLookup() 'unregister custom control class
          PostQuitMessage 0
          FUNCTION = %FALSE
          EXIT FUNCTION
          CASE %BN_CLICKED
    
        CASE %WM_CREATE
          ' Create font used by container
    
          hFont = GetStockObject(%DEFAULT_GUI_FONT)
    
          ' Create the LookUp control (this is not the editbox and/or button that exist within the lookup control, this is the class that creates the controls
          hWndChild = CreateWindowEx(%WS_EX_CLIENTEDGE, _                                 ' extended styles
                                     "Lookup", _                                            ' class name
                                     "", _                                                ' caption
                                     %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _         ' window styles
                                     16, 10, _                                            ' left, top
                                     212, 22, _                                           ' width, height
                                     hWnd, %IDC_FORM2_LOOKUP1, _                          ' handle of parent, control ID
                                     ghInstance, BYVAL %null)
          SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
        hLookup = hwndchild
    
    'next line breaks the program (can't seem to subclass the control, not sure why)
        oldproc =  SetWindowLong(hLookup, %GWL_WNDPROC, CODEPTR(LookupProc)) 'this line breaks the program, not sure why
    'end next line breaks program
    
          hWndChild = CreateWindowEx(%NULL, _                                             ' extended styles
                                     "Button", _                                          ' class name
                                     "OK", _                                              ' caption
                                     %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _         ' window styles
                                     %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _       ' class styles
                                     145, 106, _                                          ' left, top
                                     63, 23, _                                            ' width, height
                                     hWnd, %IDC_FORM2_TEXTBTN1, _                         ' handle of parent, control ID
                                     ghInstance, BYVAL %NULL)                             ' handle of instance, creation parameters
          SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
    
          FUNCTION = %FALSE
          EXIT FUNCTION
      END SELECT
    
      FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
    
    END FUNCTION
    
    FUNCTION LookupProc(hwnd AS LONG, msg AS LONG, wparam AS LONG, lparam AS LONG) AS LONG
    'subclass the custom control (subclass to the container)
     #DEBUG PRINT "if you subclass the lookup control hwnd is zero on the first call to the subclass proc - I am not sure why"
    FUNCTION = callwindowproc(oldproc,hwnd,msg,wparam,lparam)
    END FUNCTION
    
    FUNCTION ContainerWndProc _
      ( _
      BYVAL hWnd    AS LONG, _ 'DWORD, _ ' window handle
      BYVAL uMsg    AS LONG, _ 'DWORD, _ ' type of message
      BYVAL wParam  AS LONG, _ 'DWORD, _ ' first message parameter
      BYVAL lParam  AS LONG _   ' second message parameter
      ) AS LONG
    
      LOCAL szItem      AS ASCIIZ * %MAX_PATH
      LOCAL tsize       AS APISIZE
      LOCAL hInstance   AS DWORD
      LOCAL hWndChild   AS DWORD    ' handle of child window
      LOCAL dwID        AS DWORD
      LOCAL hFont       AS DWORD    ' handle of font used by parent
      LOCAL hDC         AS DWORD
      LOCAL dx          AS LONG
      LOCAL cxButton    AS LONG
      LOCAL pmyStruct AS createstruct PTR 'for wm_create
    
      SELECT CASE uMsg
    
        CASE %WM_COMMAND
           SELECT CASE LOWRD(wParam)
    
                    CASE %IDC_button
                    IF HIWRD(wparam) = %BN_CLICKED THEN
                       #DEBUG PRINT "%bn_clicked"
                    END IF
           END SELECT
        CASE %WM_SETFOCUS
          ' Set the keyboard focus to the child edit control
          SetFocus GetDlgItem(hWnd, %IDC_edit)
    
        CASE %WM_SIZE
          ' Size the children of our custom control
          hDC = GetDC(%NULL)
          szItem = "..."
          GetTextExtentPoint32 hDC, szItem, LEN(szItem), tsize
          ReleaseDC %NULL, hDC
          dx = GetSystemMetrics(%SM_CXFIXEDFRAME)
          cxButton = dx + tsize.cx + dx
          hWndChild = GetDlgItem(hWnd, %IDC_button)
          SetWindowPos hWndChild, %NULL, LOWRD(lParam) - cxButton, 0, cxButton, HIWRD(lParam), %SWP_NOZORDER OR %SWP_NOACTIVATE
          hWndChild = GetDlgItem(hWnd,%IDC_edit)
          SetWindowPos hWndChild, %NULL, 0, 0, LOWRD(lParam) - cxButton - 1, HIWRD(lParam), %SWP_NOZORDER OR %SWP_NOACTIVATE
       CASE %WM_NCCREATE 'first call b4 wm_create
    'happens b4 wm_create
        CASE %WM_PAINT
        CASE %WM_CREATE
    'warning hwnd is for the control here not the editbox
    
          hInstance = GetModuleHandle(BYVAL %NULL)
          hfont = GetStockObject(%ANSI_VAR_FONT) 'ken did this
          ' Create the LookUp edit control
    
          hWndChild = CreateWindowEx(%NULL, _                                             ' extended styles
                                     "Edit", _                                            ' class name
                                     "", _                                                ' caption
                                     %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _         ' window styles
                                     %ES_LEFT OR %ES_AUTOHSCROLL, _                       ' class styles
                                     0, 0, _                                              ' left, top
                                     166, 15, _                                           ' width, height
                                     hwnd,  %idc_edit, _                            ' handle of parent, control ID (parent is container)
                                     hInstance, BYVAL %NULL)                              ' handle of instance, creation parameters
        oldproc  = SetWindowLong(hwndchild, %GWL_WNDPROC, CODEPTR(editprocdll))  'global ok since all edits have same oldproc
    
        IF hFont THEN SendMessage hwndchild, %WM_SETFONT, hFont, 0
     hedit = hwndChild
    ' Create the custom control's button
          hWndChild = CreateWindowEx(%NULL, _                                             ' extended styles
                                     "Button", _                                          ' class name
                                     "...", _                                             ' caption
                                     %WS_CHILD OR %WS_VISIBLE OR _                        ' window styles
                                     %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _       ' class styles
                                     167, 0, _                                            ' left, top
                                     15, 15, _                                            ' width, height
                                    hwnd, %idc_button, _                         ' handle of parent, control ID  (was hwnd) (parent is container)
                                     hInstance, BYVAL %NULL)                              ' handle of instance, creation parameters
     IF hFont THEN SendMessage hwndchild, %WM_SETFONT, hFont, 0 'ken did this 082617
    oldprocbtn = SetWindowLong(hwndchild, %GWL_WNDPROC, CODEPTR(btnprocdll))  'global ok since all buttons have same oldprocbtn
    hbtn = hwndchild
          FUNCTION = %FALSE
          EXIT FUNCTION
      END SELECT
    
      FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
    END FUNCTION
    
    FUNCTION EditProcDll( _
    BYVAL hWnd    AS LONG, _ 'DWORD, _ ' window handle
    BYVAL wMsg    AS LONG, _ 'DWORD, _ ' type of message
    BYVAL wParam  AS LONG, _ 'DWORD, _ ' first message parameter
    BYVAL lParam  AS LONG _   ' second message parameter
    ) AS LONG
    
    'force numeric entry just for fun
    SELECT CASE wMsg
        CASE %WM_CREATE
    
    
        CASE %WM_KEYDOWN
    
        CASE %WM_CHAR
    
            '// This is only written for example purposes.
            '// It is a simple piece of code to suppress the characters except numbers.
            SELECT CASE ASC( UCASE$( CHR$( wParam ) ) )
            CASE < 32
            CASE ASC( "0" ) TO ASC( "9" )
            CASE ELSE
    
                BEEP
                EXIT FUNCTION
    
            END SELECT
    
          END SELECT
      FUNCTION = callwindowproc(oldproc,hwnd,wmsg,wparam,lparam) ' defwindowproc(hwnd,wmsg,wparam,lparam)
    
    END FUNCTION
    
    FUNCTION BtnProcDll( _
    BYVAL hWnd    AS LONG, _ 'DWORD, _ ' window handle
    BYVAL wMsg    AS LONG, _ 'DWORD, _ ' type of message
    BYVAL wParam  AS LONG, _ 'DWORD, _ ' first message parameter
    BYVAL lParam  AS LONG _   ' second message parameter
    ) AS LONG
    
    
    
     SELECT CASE wMsg
       CASE %WM_LBUTTONDOWN
        CASE %WM_LBUTTONUP
            MSGBOX "i feel you clicking my buttons."
    
        END SELECT
    
         FUNCTION = CallWindowProc(oldprocbtn, hWnd, wMsg, wParam, lParam ) 'do this to stop exe from getting a chance to process messages
    
    END FUNCTION
    
    ' ------------------------------------------------------------------------
    
    FUNCTION DeleteLookup(BYVAL hwnd AS DWORD) AS LONG
    
    'hwnd is cust control container
    IF hbtn THEN
     setWindowLong hbtn, %GWL_WNDPROC,oldprocbtn 'reverse the button subclass
     hbtn = 0
     END IF
     IF hedit THEN
     setWindowLong hedit, %GWL_WNDPROC,oldproc 'reverse the edit subclass
     hedit = 0
     END IF
    
     END FUNCTION
    
    
    FUNCTION RegisterLookup() AS LONG
      LOCAL szClassName   AS ASCIIZ * %MAX_PATH   ' class name
      LOCAL twcx          AS WNDCLASSEX           ' class information
      LOCAL lret AS LONG
      gclassname = $ControlClassName 'Lookup
      ' Register the LookUp window
      szClassName        = gClassName                                 'set gclassname to null when control is unregistered
      twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
      twcx.style         = %CS_DBLCLKS OR %CS_GLOBALCLASS             ' class styles
      twcx.lpfnWndProc   = CODEPTR(ContainerWndProc)                  ' address of window procedure used by the class (not wndproc of child controls (like editbox etc)
      twcx.cbClsExtra    = 0                                          ' extra class bytes (shared by all windows)
      twcx.cbWndExtra    = %ControlExtraData * 4                      ' extra window bytes (private to each window) see setcontroldata getcontroldata for use. *4 because each long uses 4 bytes
      twcx.hInstance     = GetModuleHandle(BYVAL %NULL)               ' instance of the EXE/DLL that is registering the window
      twcx.hIcon         = %NULL                                      ' handle of class icon
      twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
      twcx.hbrBackground = %COLOR_BTNFACE + 1                         ' brush used to fill background of window's client area
      twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
      twcx.lpszClassName = VARPTR(szClassName)                        ' class name
      twcx.hIconSm       = %NULL                                      ' handle of small icon shown in caption/system Taskbar
     lret = RegisterClassEx(twcx) 'returns atom see above from msdn
    
     FUNCTION = lret 'pointer to structure see registerclassex docs (you can use this pointer with getclassinfoex)
    END FUNCTION
    
    
    FUNCTION UnRegisterLookup() AS LONG
    LOCAL szClassName AS ASCIIZ * 250
    
      IF gclassname <> "" THEN
       szClassName = gclassname 'classname$
        UnregisterClass(szClassName,getmodulehandle(BYVAL %null))
        gclassname = ""
        END IF
    
    END FUNCTION

  • #2
    Since this is a custom control, the only global variable, if any, should be handle of the instance.

    And it is because of the global variables you are in trouble.

    Look carefully at what you did with the oldproc variable.

    Code:
        oldproc =  SetWindowLong(hLookup, %GWL_WNDPROC, CODEPTR(LookupProc)) 'this line breaks the program, not sure why

    Code:
        oldproc  = SetWindowLong(hWndChild, %GWL_WNDPROC, CODEPTR(editprocdll))  'global ok since all edits have same oldproc

    Minor error

    Change IDOK TO IDC_FORM2_TEXTBTN1

    Miscellaneous
    There might be timing issues because it is an exe. It GPF when the property of the container is examined with Spy++.

    Put the control code in a DLL to see if that solves the problem

    or while it is in the form of an exe

    post a message (WM_USER+xxx) at the beginning of WM_CREATE in Form2_WndProc that subclasses the container when it is received

    or

    use WM_ENTERIDLE in Form2_WndProc to subclass the container.

    For example

    Code:
    FUNCTION Form2_WndProc _
      ( _
      BYVAL hWnd    AS DWORD, _ ' window handle
      BYVAL uMsg    AS DWORD, _ ' type of message
      BYVAL wParam  AS DWORD, _ ' first message parameter
      BYVAL lParam  AS LONG _   ' second message parameter
      ) AS LONG
    
      LOCAL hWndChild   AS DWORD    ' handle of child window
      LOCAL hFont       AS DWORD    ' handle of font used by parent
      LOCAL lret AS LONG
    
      SELECT CASE uMsg
        CASE %WM_USER + 500
          IF hLookup THEN
        oldproc =  SetWindowLong(hLookup, %GWL_WNDPROC, CODEPTR(LookupProc)) 'this line breaks the program, not sure why
          END IF
    '
        CASE %WM_CREATE
        PostMessage hWnd, %WM_USER + 500, 0, 0


    Last edited by Dominic Mitchell; 10 Sep 2017, 05:31 AM. Reason: WM_ENTERIDLE needs a flag to prevent repeated subclassing
    Dominic Mitchell
    Phoenix Visual Designer
    http://www.phnxthunder.com

    Comment


    • #3
      Thank you, Dominic. And thank you for your original post on superclassing many years ago which was a big eye opener for me.

      I also noticed (after posting) that the subproc for the custom control was not defined with arguments BYVAL.

      I will clean up these problems and repost once I get everything working well.

      Much appreciated.

      Ken Levin

      Comment


      • #4
        Use a custom message rather than WM_ENTERIDLE, because WM_ENTERIDLE needs a flag to prevent repeated sublassing of the control.
        Dominic Mitchell
        Phoenix Visual Designer
        http://www.phnxthunder.com

        Comment


        • #5
          Thank you again Dominic.

          Here is an updated program that eliminates the use of globals (except for the hwnd of the custom control I created (hlookup).

          I no longer have my original problem when I try to subclass the custom control's container.

          I eliminated globals by creating extra window bytes on the custom control's container, create a heap of memory (using heapallocate) then storing the address of that heap 3 different ways (%gwl_userdata, setprop and with the extra window bytes). This example is redundant (because I use three methods), however, it shows some of the ways a user can store extra data without resorting to globals.

          Hints on how this might be made more perfect would be appreciated.

          Ken Levin

          Code:
          'based on an example posted by Dominic at:
          ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/7792-superclass-new-control?t=7539&highlight=container+custom+control
          '
          'demonstrates creating a custom control based on creation of a container then subclassing the custom control
          '
          'shows one way to handle messaging within the custom control.
          'the program uses globals and shows 3 alternate (all preferred) methods to storing control data so globals don't have to be used.
          '
          'notice how messages are forwarded from editprocinternal and btnprocinternal to the container, you can pass on whatever messages you want to support for the custom control
          
          #DIM ALL
          #REGISTER NONE
          #COMPILE EXE
          
          #INCLUDE "WIN32API.INC"
          
          '=========================== [ Control Identifiers ] ===========================
          
          ' Form2
          %IDD_FORM2                      = 1000
          %IDC_FORM2_LOOKUP1              = 1001
          %IDC_ok                         = 1002
          %idc_control                    = %WM_USER+1000 'controlid for custom control
          '%idc_button                     = %WM_USER + 1001  'controlid of button contained in custom control
          '%idc_edit                       = %WM_USER + 1002  'controlid of editbox contained in custom control
          %ControlWindowExtraData         = 5
          $ControlClassName               ="Lookup"
          
          
          'GLOBAL oldproc AS DWORD PTR 'containter for the custom control (see plookuptyp for alternate method to store this data)
          'GLOBAL oldprocbtn AS DWORD PTR 'button within the container (see plookuptyp for alternate method to store this data)
          'GLOBAL oldprocedit AS DWORD PTR 'edit control within the container (see lookuptyp for alternate method)
          GLOBAL  ghInstance AS DWORD
          GLOBAL hLookup AS DWORD  'custom control's hwnd, we're just creating one for this sample program
          'GLOBAL hEdit AS DWORD  'hwnd of the editbox that is a child of the custom control's container (see lookuptyp for alternate method)
          'GLOBAL hBtn AS DWORD   'hwnd of button that is a child of the custom control's container (see lookuptyp for alternate method)
          GLOBAL gClassName AS STRING 'global which is used as a flag to know if custom control is registered (set in registerlookup)
          
          
          TYPE LookUpTyp  'create one per instance of the custom control, created with heapallocate, stored in custom control's window extra bytes + userdata (redundant) + setprop/getprop
          oldproc AS DWORD PTR 'container's codeptr
          oldprocbtn AS DWORD PTR 'btn's codeptr
          oldprocedit AS DWORD PTR 'edit control's codeptr
          hlookup AS DWORD  'container window hwnd
          hedit AS DWORD  'edit control hwnd
          hbtn AS DWORD   'button control hwnd
          hControl AS DWORD 'container control hwnd
          ctrlid AS LONG 'id of custom control
          ctrlidedit AS LONG 'id of editbox within custom control
          ctrlidbtn AS LONG 'id of button within custom control
          END TYPE
          
          '====================== [ Global Variable Declarations ] =======================
          '-------------------------------------------------------------------------------
          '
          ' PROCEDURE: WinMain
          ' PURPOSE:   Program entry point, calls initialization function, processes
          '            message loop.
          '
          '-------------------------------------------------------------------------------
          
          FUNCTION WINMAIN _
            ( _
            BYVAL hInstance     AS LONG, _        ' handle of current instance
            BYVAL hPrevInstance AS LONG, _        ' handle of previous instance(not used in Win32)
                  BYVAL pszCmdLine    AS ASCIIZ PTR, _  ' address of command line
            BYVAL nCmdShow      AS LONG _         ' show state of window
            ) AS LONG
          
            LOCAL szClassName   AS ASCIIZ * %MAX_PATH   ' class name
            LOCAL twcx          AS WNDCLASSEX           ' class information
            LOCAL tmsg          AS tagMsg               ' message information
            LOCAL hWnd          AS DWORD                ' handle of main window
            LOCAL lret AS LONG
          
            ' Save the handle of the application instance
            ghInstance = hInstance
            CALL logit("",1) 'diagnostics
          
            szClassName        = "Form2_Class"
            twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
            twcx.style         = %CS_DBLCLKS                                ' class styles
            twcx.lpfnWndProc   = CODEPTR(Form2_WndProc)                     ' address of window procedure used by class
            twcx.cbClsExtra    = 0                                          ' extra class bytes
            twcx.cbWndExtra    = 0                                          ' extra window bytes
            twcx.hInstance     = ghInstance                                 ' instance of the EXE that is registering the window
            twcx.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of class icon
            twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
            twcx.hbrBackground = %COLOR_BTNFACE + 1                         ' brush used to fill background of window's client area
            twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
            twcx.lpszClassName = VARPTR(szClassName)                        ' class name
            twcx.hIconSm       = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of small icon shown in caption/system Taskbar
            IF ISFALSE RegisterClassEx(twcx) THEN
              FUNCTION = %FALSE
              EXIT FUNCTION
            END IF
          
           ' Register custom control
           lret =  RegisterLookup() 'see lookupproc wm_create and wm_nccreate to learn how control initializes itself
           IF lret = 0 THEN MSGBOX "Could not Register Custom Control. Aborting. " : EXIT FUNCTION
          
             ' Create the Form2 window (main program window)
             hWnd = CreateWindowEx(%WS_EX_WINDOWEDGE, _                                          ' extended styles
                                  "Form2_Class", _                                              ' class name
                                  "Enter numbers only in editbox", _                                                  ' caption
                                  %WS_OVERLAPPEDWINDOW OR %WS_VISIBLE, _                        ' window styles
                                  70, 94, _                                                     ' left, top
                                  360, 178, _                                                   ' width, height
                                  %NULL, %NULL, _                                               ' handle of owner, menu handle
                                  ghInstance, BYVAL %NULL)                                      ' handle of instance, creation parameters
            ' If window could not be created, return "failure"
            IF ISFALSE hWnd THEN
              FUNCTION = %FALSE
              EXIT FUNCTION
            END IF
          
            ' Make the window visible; update its client area
            ShowWindow hWnd, %SW_SHOW
            UpdateWindow hWnd
          
            ' Main message loop of program.
            ' Acquire and dispatch messages until a WM_QUIT message is received.
            WHILE ISTRUE GetMessage(tmsg, BYVAL %NULL, 0, 0)
              IF ISFALSE IsDialogMessage(hWnd, tmsg) THEN
                TranslateMessage tmsg
                DispatchMessage tmsg
              END IF
            WEND
          
            FUNCTION = tmsg.wParam
          
          END FUNCTION
          
          '-------------------------------------------------------------------------------
          '
          ' PROCEDURE: Form2_WndProc
          ' PURPOSE:   Processes messages for the Form2 window.
          '
          '-------------------------------------------------------------------------------
          
          FUNCTION Form2_WndProc _
            ( _
            BYVAL hWnd    AS DWORD, _ ' window handle
            BYVAL uMsg    AS DWORD, _ ' type of message
            BYVAL wParam  AS DWORD, _ ' first message parameter
            BYVAL lParam  AS LONG _   ' second message parameter
            ) AS LONG
          
            LOCAL hWndChild   AS DWORD    ' handle of child window
            LOCAL hFont       AS DWORD    ' handle of font used by parent
            LOCAL lret AS LONG
          
            SELECT CASE uMsg
              CASE %WM_COMMAND
          
                SELECT CASE LOWRD(wParam)
                 CASE %IDC_Control
                      IF HIWRD(wParam) = %BN_CLICKED THEN
                       MSGBOX "wndproc bn_clicked for custom control's button"
                      END IF
                  CASE %IDC_OK
                    IF HIWRD(wParam) = %BN_CLICKED THEN
                      PostMessage hWnd, %WM_CLOSE, 0, 0
                    END IF
          
                END SELECT
          
              CASE %WM_ACTIVATE
          
              CASE %WM_DESTROY
          
           'remove setprop property
           removeprop(hlookup,"plookuptyp") 'do this for each control if using setprop/getprop (these are redundant and included for demo purposes only)
          
           'finish clean up the custom control, we could move the above removeprop into the deletelookup function, however setprop was redundant and for demo purposes only
                 deleteLookup(hLookup) 'call once for each control created in the program and send the hwnd for each custom control to the function
                 UnRegisterLookup() 'unregister custom control class, do this once for all custom controls
          
                PostQuitMessage 0
                FUNCTION = %FALSE
                EXIT FUNCTION
                CASE %BN_CLICKED
          
              CASE %WM_CREATE
                ' Create font used by container
          
                hFont = GetStockObject(%DEFAULT_GUI_FONT)
          
           ' Creates the LookUp custom control, the custom control will self initialize in either wm_create or wm_nccreate of the lookupproc associated with the control
           'lookupproc is associated with the control in registerlookup (when we register the custom class)
                hWndChild = CreateWindowEx(%WS_EX_CLIENTEDGE, _                                 ' extended styles
                                           "Lookup", _                                            ' class name
                                           "", _                                                ' caption
                                           %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, _         ' window styles
                                           16, 10, _                                            ' left, top
                                           212, 22, _                                           ' width, height
                                           hWnd, %IDC_FORM2_LOOKUP1, _                          ' handle of parent, control ID
                                           ghInstance, BYVAL %null)
                SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
              hLookup = hwndchild
          'subclass this control moved to wm_create in lookupproc
          
             hWndChild = CreateWindowEx(%NULL, _                                             ' extended styles
                                           "Button", _                                          ' class name
                                           "OK", _                                              ' caption
                                           %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _         ' window styles
                                           %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _       ' class styles
                                           145, 106, _                                          ' left, top
                                           63, 23, _                                            ' width, height
                                           hWnd, %IDC_OK, _                         ' handle of parent, control ID
                                           ghInstance, BYVAL %NULL)                             ' handle of instance, creation parameters
                SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
          
                FUNCTION = %FALSE
                EXIT FUNCTION
            END SELECT
          
            FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
          
          END FUNCTION
          
          FUNCTION LookupProc(BYVAL hwnd AS LONG,BYVAL msg AS LONG,BYVAL wparam AS LONG,BYVAL lparam AS LONG) AS LONG
          'subclass proc for custom control
          LOCAL plookuptyp AS lookuptyp PTR
          plookuptyp = getcontroldata(hwnd,1)
          'subclass the custom control (subclass to the container)
          
              LOCAL trect AS rect
             LOCAL pt AS POINT
              LOCAL lret AS LONG, hdc AS DWORD
             ' CALL logit("editbtncproc in exe msg = " & STR$(msg))
          SELECT CASE MSG
           CASE %WM_COMMAND
             '   SELECT CASE LOWRD(wParam)
          
                         ' CASE %IDC_control 'yes, of course because the control is subclassed, this is what you need to do in wndproc if control not subclassed
                          IF HIWRD(wparam) = %BN_CLICKED THEN
                              MSGBOX "my button just clicked subclass of custom control"
                              CALL logit("custom bn_clicked in custom control's window subclass custom control") 'works 082917
                          END IF
               '  END SELECT
          
            CASE %WM_CREATE 'copied from other
                CALL logit("visited custom control's subclass wmcreate wparam = " & STR$(WPARAM) & " lparam = " & STR$(LPARAM) & " hwnd = " & STR$(hwnd))
           '  FUNCTION=0
           ' EXIT FUNCTION
          CASE %WM_NCCREATE
              CALL logit("nccreate")
             CASE %WM_PAINT
                '#debug print "paint"
            CASE %WM_DESTROY
                CALL logit("destroy")
            CASE %WM_NCDESTROY
                CALL logit("ncdestroy")
            CASE %WM_CHAR
                CALL logit("wm_char")
            CASE %WM_KEYDOWN 'gets arrow keys too, not just letters which are trapped by wm_char
                 CALL logit("keydown in exe")
          
            CASE %WM_LBUTTONDOWN
           'suspect no longer needed 082117 see nclbuttondown and nclbuttonup (adding wm_setcursor stopped lbuttondown and lbuttonup from firing with mouse over button, not sure why)
            CALL LOGIT("LBUTTONDOWN editbtncproc exe")
          
            CASE %WM_SETFOCUS 'sent just after edit gets focus and is not fired if
              '  #debug print "setfocus " & str$(gmouseoverbtn)
              CALL logit("setfocus")
               CASE %WM_KILLFOCUS 'sent just before focus lost on editbox
                   CALL logit("killfocus")
              CASE %WM_NCCALCSIZE
                   CALL logit("nccalcsize")
               CASE %WM_NCPAINT
          
               CALL logit("ncpaint")
            CASE %WM_NCHITTEST
             CASE %WM_NCLBUTTONDBLCLK
              CASE %WM_NCLBUTTONDOWN
             CALL LOGIT("NCLBUTTONDOWN editbtncproc exe")
              CASE %WM_NCLBUTTONUP
              CALL logit("nclbuttonup editbtncproc exe")
              MSGBOX "your exe just got its button clicked"
              CASE %WM_MOUSEMOVE
          
          '    CASE %wm_setcursor
             CASE %WM_LBUTTONUP
          
                CALL logit("lbuttonup editbtnproc exe")
              CASE %WM_SIZE  'in the cbWndExtra bytes.
          '
          END SELECT
          FUNCTION = callwindowproc(@plookuptyp.oldproc,hwnd,msg,wparam,lparam)
          END FUNCTION
          
          FUNCTION ContainerWndProc _
            ( _
            BYVAL hWnd    AS LONG, _ 'DWORD, _ ' window handle
            BYVAL uMsg    AS LONG, _ 'DWORD, _ ' type of message
            BYVAL wParam  AS LONG, _ 'DWORD, _ ' first message parameter
            BYVAL lParam  AS LONG _   ' second message parameter
            ) AS LONG
          
            LOCAL szItem      AS ASCIIZ * %MAX_PATH
            LOCAL tsize       AS APISIZE
            LOCAL hInstance   AS DWORD
            LOCAL hWndChild   AS DWORD    ' handle of child window
            LOCAL dwID        AS DWORD
            LOCAL hFont       AS DWORD    ' handle of font used by parent
            LOCAL hDC         AS DWORD
            LOCAL dx          AS LONG
            LOCAL cxButton    AS LONG
            LOCAL pmyStruct AS createstruct PTR 'for wm_create
            LOCAL pLookUpTyp AS LookupTyp PTR
            LOCAL zstr AS ASCIIZ * 15
            LOCAL lret AS LONG, lret1 AS LONG
            STATIC idcnt AS LONG 'to assign ctrlids for editbox and button
          
             plookuptyp = getcontroldata(hwnd,1) 'is zero on first call wm_nccreate else should be defined
            'this wndproc belongs to the container
            'the container creates subcontrols in its wm_create section but doesn't do much else
            'I subclassed the edit control to editprocinternal and editprocinternal preprocesses the edit control's
          
            SELECT CASE uMsg
          
              CASE %WM_COMMAND
                    IF HIWRD(wparam) = %BN_CLICKED THEN
                            MSGBOX "%bn_clicked container"
                    END IF
          
              CASE %WM_SETFOCUS
                ' Set the keyboard focus to the child edit control
                SetFocus GetDlgItem(hWnd, @plookuptyp.ctrlidedit)
          
              CASE %WM_SIZE
                ' Size the children of our custom control
                hDC = GetDC(%NULL)
                szItem = "..."
                GetTextExtentPoint32 hDC, szItem, LEN(szItem), tsize
                ReleaseDC %NULL, hDC
                dx = GetSystemMetrics(%SM_CXFIXEDFRAME)
                cxButton = dx + tsize.cx + dx
                hWndChild = GetDlgItem(hWnd, @plookuptyp.ctrlidbtn) '%IDC_button)
                SetWindowPos hWndChild, %NULL, LOWRD(lParam) - cxButton, 0, cxButton, HIWRD(lParam), %SWP_NOZORDER OR %SWP_NOACTIVATE
                hWndChild = GetDlgItem(hWnd,@plookuptyp.ctrlidedit) '%IDC_edit)
                SetWindowPos hWndChild, %NULL, 0, 0, LOWRD(lParam) - cxButton - 1, HIWRD(lParam), %SWP_NOZORDER OR %SWP_NOACTIVATE
             CASE %WM_NCCREATE 'first call b4 wm_create
              CALL logit("wm_nccreate in container proc")
           'create some memory space for the custom control, we'll use this as global memory space for this window's instance
           ' so mult custom controls won't step on each other's memory space
           pmystruct = lparam 'pointer to a createstruct
             IF plookuptyp = 0 THEN
           'create some memory space to hold custom control data we want to save
             plookuptyp = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, SIZEOF(@plookuptyp))
             @plookuptyp.hcontrol = hwnd
             '@plookuptyp.registered = 1 'has to be registered if you get here, can't do this in registereditbtn since we don't have the heap
             'don't know controlids yet
          
          'save the pointer to the memory space as an extrawindowbyte (not a classbyte which is shared between multiple instances of the control)
             setcontroldata(hwnd,1,plookuptyp) 'save the memory heap on extra window byte
           'test to see if it worked
           IF getcontroldata(hwnd,1) <> plookuptyp THEN
              MSGBOX "unexpected data when retrieving extra window byte data."
             END IF
          
          'now redundantly save the address of plookuptyp in the custom control's user data (just to demonstrate how, this is redundant.
          'using user space is not a good idea if you intend to package the control in a dll and permit a third party to use it as the third party
          'may have a need to use the user space. shown here as a demo only
           setwindowlong hwnd, %gwl_userdata, plookuptyp 'store memory block address of plookuptyp in the container's user data space
           lret1 = getwindowlong(hwnd,%gwl_userdata) 'should return lret1 and lret1 should equal pcustedit
           IF lret1 <> plookuptyp THEN
               MSGBOX "retriving user data caused an unexpected result."
           END IF
          
          'and a third method, store data using setprop and get it with getprop
          zstr = "plookuptyp"
          setprop(hwnd,zstr,plookuptyp) 'zstr identifies the property, plookuptyp is a pointer to our property list (remove with removeprop)
          'test to see if it worked
          lret = getprop(hwnd,zstr) 'lret should equal plookuptyp
          IF lret <> plookuptyp THEN
              MSGBOX "setprop didn't work."
          END IF
          
            CALL logit("all should be equal: " & STR$(getcontroldata(hwnd,1)) & "," & STR$(plookuptyp) & "," & STR$(lret) & "," & STR$(lret1))
          
             END IF
          '    CASE %WM_PAINT
              CASE %WM_CREATE
          'warning hwnd is for the control here not the editbox or buttob
          
                hInstance = GetModuleHandle(BYVAL %NULL)
                hfont = GetStockObject(%ANSI_VAR_FONT)
           'initialize the LookUp control's components, use wm_paint if you need to draw something
          
          'editbox is a child of the custom control
          'we need a ctrlid for the editbox and we want it to be an internal number and allow it to work if there are multiple custom controls
          idcnt = idcnt+1
          @plookuptyp.ctrlidedit = %WM_USER + 3000 + idcnt '%idc_edit
                hWndChild = CreateWindowEx(%NULL, _                                             ' extended styles
                                           "Edit", _                                            ' class name
                                           "", _                                                ' caption
                                           %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _         ' window styles
                                           %ES_LEFT OR %ES_AUTOHSCROLL, _                       ' class styles
                                           0, 0, _                                              ' left, top
                                           166, 15, _                                           ' width, height
                                          hwnd,  @plookuptyp.ctrlidedit, _ '%idc_edit, _        ' handle of parent, control ID (parent is container)
                                           hInstance, BYVAL %NULL)                              ' handle of instance, creation parameters
          'subclass the editbox of the custom control (different than subclassing the custom control)
              @plookuptyp.oldprocedit  = SetWindowLong(hwndchild, %GWL_WNDPROC, CODEPTR(editprocinternal))  'global ok since all edits have same oldproc
          
              IF hFont THEN SendMessage hwndchild, %WM_SETFONT, hFont, 0
          @plookuptyp.hedit = hwndChild
          
          ' Create the custom control's button
          idcnt = idcnt+1
          @plookuptyp.ctrlidbtn = %WM_USER + 3000 + idcnt '%idc_button
                hWndChild = CreateWindowEx(%NULL, _                                             ' extended styles
                                           "Button", _                                          ' class name
                                           "...", _                                             ' caption
                                           %WS_CHILD OR %WS_VISIBLE OR _                        ' window styles
                                           %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _       ' class styles
                                           167, 0, _                                            ' left, top
                                           15, 15, _                                            ' width, height
                                          hwnd, @plookuptyp.ctrlidbtn, _ '%idc_button, _        ' handle of parent, control ID  (was hwnd) (parent is container)
                                           hInstance, BYVAL %NULL)                              ' handle of instance, creation parameters
           IF hFont THEN SendMessage hwndchild, %WM_SETFONT, hFont, 0
          'subclass the button of the custom control (different than subclassing the custom control)
          @plookuptyp.oldprocbtn = SetWindowLong(hwndchild, %GWL_WNDPROC, CODEPTR(btnprocinternal))  'global ok since all buttons have same oldprocbtn
          @plookuptyp.hbtn = hwndchild
          
          'subclass the container control (alternatively you could post a custom message to this control if there are timing issues (if windows needs more time to digest its work)
          'if posting a message postmessage hwnd,%wm_user+xyz,0,0) 'and then in case %wm_user+xyz you would run the below code to subclass the custom control's container
           @plookuptyp.oldproc =  SetWindowLong(hwnd, %GWL_WNDPROC, CODEPTR(LookupProc)) 'hwnd is the control
                FUNCTION = %FALSE
                EXIT FUNCTION
          CASE %WM_LBUTTONDOWN
              CALL logit("lbuttondown in container ")
          CASE %WM_LBUTTONUP
              CALL logit("lbuttonup in container " )
          CASE %WM_NCLBUTTONDOWN
              CALL logit("nclbuttondown in container ")
          CASE %WM_NCLBUTTONUP
              CALL logit("nclbuttonup in container ")
          CASE %WM_KEYDOWN
              CALL logit("keydown in container ")
          CASE %WM_CHAR
              CALL logit("wm_char in container")
            END SELECT
          
            FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
          END FUNCTION
          
          FUNCTION editprocinternal( _
          BYVAL hWnd    AS LONG, _ 'DWORD, _ ' window handle
          BYVAL wMsg    AS LONG, _ 'DWORD, _ ' type of message
          BYVAL wParam  AS LONG, _ 'DWORD, _ ' first message parameter
          BYVAL lParam  AS LONG _   ' second message parameter
          ) AS LONG
          LOCAL plookuptyp AS lookuptyp PTR
          plookuptyp = getcontroldata(getparent(hwnd),1) 'plookuptyp is strored in the container's extra window bytes
          'force numeric entry just for fun
          SELECT CASE wMsg
              CASE %WM_CREATE
          
          
              CASE %WM_KEYDOWN
                 CALL logit("wm_keydown edit")
              sendmessage(getparent(hwnd),%WM_KEYDOWN,wparam,lparam)
              CASE %WM_LBUTTONDOWN
                  CALL logit("wm_lbuttondown edit")
              sendmessage(getparent(hwnd),%WM_LBUTTONDOWN,wparam,lparam)
              CASE %WM_LBUTTONUP
                  CALL logit("wm_lbuttonup edit")
              sendmessage(getparent(hwnd),%WM_LBUTTONUP,wparam,lparam)
              CASE %WM_NCLBUTTONDOWN
                  CALL logit("wm_nclbuttondown edit")
              sendmessage(getparent(hwnd),%WM_NCLBUTTONDOWN,wparam,lparam)
              CASE %WM_NCLBUTTONUP
              CALL logit("wm_nclbuttonup edit")
              sendmessage(getparent(hwnd),%WM_NCLBUTTONUP,wparam,lparam)
          
              CASE %WM_CHAR
                   CALL logit("wm_char edit")
                  '// This is only written for example purposes.
                  '// It is a simple piece of code to suppress the characters except numbers.
                  SELECT CASE ASC( UCASE$( CHR$( wParam ) ) )
                  CASE < 32
                  CASE ASC( "0" ) TO ASC( "9" )
                      sendmessage(getparent(hwnd),%WM_CHAR,wparam,lparam) 'so parent gets wm_char for a legal character entry else we eat the message
                  CASE ELSE
          
                      BEEP
                      EXIT FUNCTION
          
                  END SELECT
          
                END SELECT
            FUNCTION = callwindowproc(@plookuptyp.oldprocedit,hwnd,wmsg,wparam,lparam) ' defwindowproc(hwnd,wmsg,wparam,lparam)
          
          END FUNCTION
          
          FUNCTION btnprocinternal( _
          BYVAL hWnd    AS LONG, _ 'DWORD, _ ' window handle
          BYVAL wMsg    AS LONG, _ 'DWORD, _ ' type of message
          BYVAL wParam  AS LONG, _ 'DWORD, _ ' first message parameter
          BYVAL lParam  AS LONG _   ' second message parameter
          ) AS LONG
          LOCAL plookuptyp AS lookuptyp PTR
          plookuptyp = getcontroldata(getparent(hwnd),1) 'plookuptyp is strored in the container's extra window bytes
          LOCAL dnumb AS DWORD
          
           SELECT CASE wMsg
             CASE %WM_LBUTTONDOWN
             CALL logit("btnproc lbuttondown")
             sendmessage(getparent(hwnd),%WM_LBUTTONDOWN,wparam,lparam)
          
              CASE %WM_LBUTTONUP
                dnumb = MAK(DWORD, GetDlgCtrlID(getparent(hwnd)),%BN_CLICKED) 'lowrd = hwnd of container, hiwrd = ctrlid of container not button
              sendmessage(getparent(hwnd),%WM_COMMAND,dnumb,hwnd)
              sendmessage(getparent(hwnd),%WM_LBUTTONUP,wparam,lparam)
                  MSGBOX "i feel you clicking my buttons in btn subclass."
                CALL logit("btnproc lbuttonup")
              END SELECT
          
               FUNCTION = CallWindowProc(@plookuptyp.oldprocbtn, hWnd, wMsg, wParam, lParam ) 'do this to stop exe from getting a chance to process messages
          
          END FUNCTION
          
          ' ------------------------------------------------------------------------
          
          FUNCTION DeleteLookup(BYVAL hwnd AS DWORD) AS LONG
           LOCAL plookuptyp AS lookuptyp PTR
          plookuptyp = getcontroldata(hwnd,1)
          'hwnd is custom control's container
          
          'remove button subclass
          IF @plookuptyp.hbtn THEN
           setWindowLong @plookuptyp.hbtn, %GWL_WNDPROC,@plookuptyp.oldprocbtn 'reverse the button subclass
           @plookuptyp.hbtn = 0
           END IF
           'remove editbox subclass
           IF @plookuptyp.hedit THEN
           setWindowLong @plookuptyp.hedit, %GWL_WNDPROC,@plookuptyp.oldprocedit 'reverse the edit subclass
           @plookuptyp.hedit = 0
           END IF
          'remove control's subclass
           IF @plookuptyp.oldproc  THEN  'remove subclass for control
                   SetWindowLong hLookup, %GWL_WNDPROC, @plookuptyp.oldProc
              END IF
          'remove the memory heap
           CALL removeheap(hwnd) 'releases heap memory
           setcontroldata(hwnd,1,0) 'set plookuptyp to zero since we just released the heap memory
          
           END FUNCTION
          
          
          FUNCTION RegisterLookup() AS LONG
            LOCAL szClassName   AS ASCIIZ * %MAX_PATH   ' class name
            LOCAL twcx          AS WNDCLASSEX           ' class information
            LOCAL lret AS LONG
            gclassname = $ControlClassName 'Lookup
            ' Register the LookUp window
            szClassName        = gClassName                                 'set gclassname to null when control is unregistered
            twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
            twcx.style         = %CS_DBLCLKS OR %CS_GLOBALCLASS             ' class styles
            twcx.lpfnWndProc   = CODEPTR(ContainerWndProc)                  ' address of window procedure used by the class (not wndproc of child controls (like editbox etc)
            twcx.cbClsExtra    = 0                                          ' extra class bytes (shared by all windows)
            twcx.cbWndExtra    = %ControlWindowExtraData* 4                      ' extra window bytes (private to each window) see setcontroldata getcontroldata for use. *4 because each long uses 4 bytes
            twcx.hInstance     = GetModuleHandle(BYVAL %NULL)               ' instance of the EXE that is registering the window
            twcx.hIcon         = %NULL                                      ' handle of class icon
            twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
            twcx.hbrBackground = %COLOR_BTNFACE + 1                         ' brush used to fill background of window's client area
            twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
            twcx.lpszClassName = VARPTR(szClassName)                        ' class name
            twcx.hIconSm       = %NULL                                      ' handle of small icon shown in caption/system Taskbar
           lret = RegisterClassEx(twcx) 'returns atom see above from msdn
          
           FUNCTION = lret 'pointer to structure see registerclassex docs (you can use this pointer with getclassinfoex)
          END FUNCTION
          
          
          FUNCTION UnRegisterLookup() AS LONG
          LOCAL szClassName AS ASCIIZ * 250
          
            IF gclassname <> "" THEN
             szClassName = gclassname 'classname$
              UnregisterClass(szClassName,getmodulehandle(BYVAL %null))
              gclassname = ""
              END IF
          
          END FUNCTION
          
          FUNCTION GetControlData(BYVAL hWnd AS LONG, BYVAL N&) AS LONG
          'use to get a stored long variable on custom control 083017 from https://www.codeproject.com/Articles/89995/Writing-Custom-Controls-Using-PowerBASIC
          LOCAL I&, RV&
          RV&=0
          IF N&>=1 AND N&<=%ControlWindowExtraData THEN
             I&=(N&-1)*4 'i is between 0 and 16. why *4? because each long takes up 4 bytes.  we allow storage of 20 bytes so 20/4 = 5
          'seems like we could store one more long, right? 083017
             IF IsWindow(hWnd) THEN
                 RV&=GetWindowLong(hWnd, I&)
             END IF
          ELSE
          MSGBOX "Illegal parameter sent to GetControlData '" & STR$(n&)
          END IF
          FUNCTION=RV&
          END FUNCTION
          
          ' ------------------------------------------------------------------------
          
          SUB SetControlData(BYVAL hWnd AS LONG, BYVAL N&, BYVAL Value&)
          'use to store a long variable on custom control 083017
          LOCAL I&
          IF N&>=1 AND N&<=%ControlWindowExtraData THEN
             I&=(N&-1)*4
             IF IsWindow(hWnd) THEN
                 SetWindowLong hWnd, I&, Value&
             ELSE
             MSGBOX "Illegal parameter '" & STR$(n&) & "' sent to SetControlData"
             END IF
          END IF
          END SUB
          
          FUNCTION Logit(msg$,OPTIONAL myreset&) AS LONG
              LOCAL tFilename$, filenum& , myreset1&
          
              LOCAL tmp$, i&, x&
              STATIC lCnt&
              ON ERROR GOTO errlabel
              IF ISMISSING(myreset&) THEN myreset1& = 0 ELSE myreset1& = myreset& '0--> no reset else reset
                tfilename$ = CURDIR$ & "\Logit.txt"
             ' msgbox "tfilename: " & tfilename$
              filenum& = FREEFILE
              lcnt& = lcnt& + 1
              IF lcnt& > 1000 THEN lcnt& = 0 : myreset1& = 1 'auto clear file after a lot of lines
           OPEN tfilename$ FOR BINARY ACCESS READ WRITE LOCK SHARED AS #filenum&
           'w/o next seek statement you always write from beg of file
           IF  myreset1& = 0 THEN
           SEEK #filenum&, LOF(filenum&)+1 'need the + 1 else will error out w/o checking if lof(#filenum&)>0 first (and last char is truncated if you don't use +1
           ELSE
           SEEK #filenum&, 1
           END IF
          PUT$ #filenum&, msg$ & $CRLF 'WRITE #filenum&, msg$
            'seteof #filenum& 'set eof to this marker, use to truncate a file, sets eof to the place where pointer is pointing
            IF myreset1& <> 0 THEN
                SETEOF #filenum&  'truncate file at current pointer location
            END IF
            CLOSE #filenum&
            EXIT FUNCTION
          errlabel:
           MSGBOX "logit " & STR$(ERR) & " - " & ERROR$
          END FUNCTION
          
          FUNCTION RemoveHeap(BYVAL hwnd AS DWORD) AS LONG
          'hwnd is custom control's container
          LOCAL plookuptyp AS lookuptyp PTR
          
          plookuptyp = getcontroldata(hwnd,1)
           IF plookuptyp THEN HeapFree (GetProcessHeap(), 0, BYVAL plookuptyp)
          END FUNCTION


          Comment


          • #6
            To ask the dumb question, why would you subclass a control you have created via superclassing?

            Shouldn't you just build the features provided by the subclassing into the window procedure for the superclass?

            Enquiring Minds Want to Know!
            Michael Mattias
            Tal Systems Inc.
            Racine WI USA
            mmattias@talsystems.com
            http://www.talsystems.com

            Comment


            • #7
              Thank you for your question, Michael. My intent is to split off the custom control into a dll. The subclassed internal components (the button and editbox) will be inside the dll. The custom control's container will be inside the dll. If the dll is to be completely separate and independent of the exe the user should be able to subclass the custom control's container. I want to keep the editbox and button hidden and unavailable to the exe.

              I actually assembled the test program I posted from a dll and a test driver (exe); I was having problems subclassing the container (which was inside the dll), so I created a stand alone example to post on the forum thinking it would be simpler. Evidently, I goofed as Dominic caught a problem in how I used some global variables. I wanted to leave the forum with a working sample that implemented Dominic's advice; I hope I succeeded. This sample would have saved me a lot of time if someone else had posted it first. Good luck to whomever comes next.

              With these last changes the test program (last posting in this thread) and its cousin, the dll and test driver I didn't post, are working well. My goal now is to make sure I'm using best practices so I can extend what I learned to other components I create. Any comments/constructive criticisms are welcome.

              I purposely used setprop, setting gwl_userdata and extra window bytes redundantly in the test program to store a pointer to my structure, just to see how all of these methods work. My preference, based on what I've read elsewhere, is to use extra window bytes.

              Best Regards

              Ken Levin

              Comment


              • #8
                Ok, so "In Real Life" I might be subclassing a window of registered class "abcdefg" without ever knowing it was created via superclassing... and this is just your development and test-bed application.

                BTW....

                My intent is to split off the custom control into a dll.
                Controls don't reside in DLLs. A DLL (or SLL) is just the packaging for executable code. A control is a window of a registered class with style WS_CHILD and owned by another window.

                (But I do know what you mean, I'm just being anal-retentive about the semantics).

                Michael Mattias
                Tal Systems Inc.
                Racine WI USA
                mmattias@talsystems.com
                http://www.talsystems.com

                Comment


                • #9
                  Thank you for the comment.

                  Yes, this is a test bed, just for learning. And, yes, my intent is that the exe software writer would never need to know the control was created with superclassing.

                  Thanks to this sample and some other great posts by others in the forum, I am much more comfortable now writing custom controls.

                  Ken Levin

                  Comment


                  • #10
                    The main problem with your code is that the test bed has access to control data it should not have access to.
                    The window hosting the control should not, under normal circumstances, have access to the inner workings of a
                    control. deleteLookup, in its present form, should not be called from Form2_WndProc.


                    The code at the end of this post shows a basic example of what you are trying to do.

                    The author of a control should never use GWL_USERDATA
                    The author of a control should never use GWL_USERDATA to store per instance data. It is set aside by the OS
                    to make it easy for users of a control to store per instance data.


                    Containers should clean up in WM_NCDESTROY not WM_DESTROY
                    The following are excerpts from a few posts I have made on this topic.

                    Excerpt 1
                    When a control can host other controls, it is far better to clean up during the WM_NCDESTROY
                    rather than the WM_DESTROY message. This has to do with the way these messages propagate.

                    When DestroyWindow is called the system may destroy many windows in addition to the window whose
                    handle was passed to DestroyWindow. For example, any windows that are owned by the window being
                    destroyed are also destroyed. In addition, any children, great grandchildren and so on are also
                    destroyed. First, the system sends each of these windows a WM_DESTROY message starting with the
                    window passed to DestroyWindow (top to bottom). Then, each of these windows receives a WM_NCDESTROY
                    message. However, the WM_NCDESTROY message is sent from the bottom-up. So the window passed to
                    DestroyWindow will be the last to receive the WM_NCDESTROY message; all its children will have
                    processed it first.

                    Therfore, to prevent or reduce the risks of general protection faults, clean up uring WM_NCDESTROY.
                    This is especially true when the embedded controls access memory allocated by the parent, or when
                    the control hosts an ActiveX control.

                    Excerpt 2
                    CASE %WM_NCDESTROY
                    ' Note: the unregistering of the superclassed edit control and the freeing of
                    ' private window data is done in WM_NCDESTROY and not in WM_DESTROY to
                    ' prevent general protection faults. The reason for this is explained below.
                    ' When DestroyWindow is called the system may destroy many windows in addition
                    ' to the window whose handle was passed to DestroyWindow. For example, any windows
                    ' that are owned by the window being destroyed are also destroyed. In addition, any
                    ' children, great grandchildren and so on are also destroyed. First, the system
                    ' sends each of these windows a WM_DESTROY message starting with the window passed
                    ' to DestroyWindow. Then, each of these windows is receives a WM_NCDESTROY message.
                    ' However, the WM_NCDESTROY message is sent from the bottom-up. So the window
                    ' passed to DestroyWindow will be the last to receive the WM_NCDESTROY message; all
                    ' its children will have processed it first.
                    ptmmbx = GetWindowLong(hWnd, %GWL_STATE)
                    UnregisterClass "PrometheusMinMaxEdit", GetAppData(%VPB_HINST_EXE)
                    IF ISTRUE ptmmbx THEN GlobalFree ptmmbx

                    CASE %WM_DESTROY
                    PostQuitMessage 0

                    FUNCTION = %FALSE
                    EXIT FUNCTION
                    END SELECT

                    FUNCTION = DefWindowProc(hWnd, lMsg, lParam1, lParam2)

                    Tip:
                    Code:
                                    WM_DESTROY     WM_NCDESTROY
                    -------------------------------------------
                    Parent Window        |            /|\
                    Tab                  |             |
                    Container1           |             |
                    Container2          \|/            |
                    You must pay attention to the propagation of the messages shown above when
                    developing a multi-layered window. Operations such as the freeing of memory
                    used by private window data, unsubclassings etc. are affected by this.
                    The best solution to this conundrum is to explicity destroy the containers
                    during the WM_DESTROY message of the parent window.
                    For example,
                    Code:
                    WM_DESTROY
                      DestroyWindow hWndContainer1
                      DestroyWindow hWndContainer2
                    Your message box will also appear in a timely manner when you do this.

                    Control identifiers of components of the container
                    Giving each child control a valid numeric identifier is optional. You can either

                    assign each one a unique identifier
                    or
                    assign all of them a value of -1(IDC_STATIC)
                    or
                    assign all of them the identifier of the container.

                    The last option makes it easy to provide a tooltip to the control.

                    Extra window bytes
                    Why is your value 5?

                    For example,
                    4 bytes stores 1 long value
                    8 bytes stores 2 long values
                    12 bytes stores 3 long values


                    Sample code
                    Code:
                    '===============================================================================
                    '------------------------------- [Test bed code] -------------------------------
                    '===============================================================================
                    
                    #DIM ALL
                    #REGISTER NONE
                    #COMPILE EXE
                    #OPTION VERSION4
                    
                    ' The following constants define the minimum required platform.  The minimum required
                    ' platform is the earliest version of Windows, Internet Explorer etc. that has the
                    ' necessary features to run your application.  Wnen defined, they enable features
                    ' available on platform versions up to and including the version specified.
                    %NTDDI_VERSION                              = &H05010000
                    %WINVER                                     = &H0501
                    %WIN32_WINNT                                = &H0501
                    %WIN32_IE                                   = &H0600
                    %UNICODE                                    = 1
                    
                    #INCLUDE ONCE "WIN32API.INC"
                    
                    '--------------------------- [ Control Identifiers ] ---------------------------
                    
                    ' Form1
                    %IDD_FORM1                                  = 100
                    %IDC_FORM1_CONTAINER                        = 101
                    
                    '---------------------- [ Global Variable Declarations ] -----------------------
                    
                    GLOBAL  ghInstance    AS DWORD    ' handle of the application instance
                    
                    '-------------------------------------------------------------------------------
                    '
                    ' PROCEDURE: WinMain
                    ' PURPOSE:   Program entry point, calls initialization function, processes
                    '            message loop.
                    '
                    '-------------------------------------------------------------------------------
                    
                    FUNCTION WINMAIN _
                      ( _
                      BYVAL hInstance     AS DWORD, _         ' handle of current instance
                      BYVAL hPrevInstance AS DWORD, _         ' handle of previous instance(not used in Win32)
                      BYVAL pszCmdLine    AS WSTRINGZ PTR, _  ' address of command line
                      BYVAL nCmdShow      AS LONG _           ' show state of window
                      ) AS LONG
                    
                      LOCAL szClassName     AS WSTRINGZ * %MAX_PATH     ' class name
                      LOCAL twcx            AS WNDCLASSEX               ' class information
                      LOCAL tmsg            AS tagMsg                   ' message information
                      LOCAL hWnd            AS DWORD                    ' handle of main window
                    
                      ' Save the handle of the application instance
                      ghInstance = hInstance
                    
                      ' Register the Form1 window
                      szClassName        = "Form1_Class"
                      twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
                      twcx.style         = %CS_DBLCLKS                                ' class styles
                      twcx.lpfnWndProc   = CODEPTR(Form1_WndProc)                     ' address of window procedure used by class
                      twcx.cbClsExtra    = 0                                          ' extra class bytes
                      twcx.cbWndExtra    = 0                                          ' extra window bytes
                      twcx.hInstance     = ghInstance                                 ' instance of the process that is registering the window
                      twcx.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of class icon
                      twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
                      twcx.hbrBackground = %COLOR_BTNFACE + 1                         ' brush used to fill background of window's client area
                      twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
                      twcx.lpszClassName = VARPTR(szClassName)                        ' class name
                      twcx.hIconSm       = %NULL                                      ' handle of small icon shown in caption/system Taskbar
                      IF RegisterClassEx(twcx) = 0 THEN
                        FUNCTION = %FALSE
                        EXIT FUNCTION
                      END IF
                    
                      ' Register Lookup control
                      IF RegisterLookup() = 0 THEN
                        FUNCTION = %FALSE
                        EXIT FUNCTION
                      END IF
                    
                      ' Create the Form1 window
                      hWnd = CreateWindowEx(%WS_EX_WINDOWEDGE, _                                          ' extended styles
                                            "Form1_Class", _                                              ' class name
                                            "Enter numbers only in editbox", _                            ' caption
                                            %WS_OVERLAPPEDWINDOW OR %WS_VISIBLE, _                        ' window styles
                                            70, 130, _                                                    ' left, top
                                            360, 374, _                                                   ' width, height
                                            %NULL, %NULL, _                                               ' handle of owner, menu handle
                                            ghInstance, BYVAL %NULL)                                      ' handle of instance, creation parameters
                      ' If window could not be created, return "failure"
                      IF hWnd = %NULL THEN
                        FUNCTION = %FALSE
                        EXIT FUNCTION
                      END IF
                    
                      ' Make the window visible; update its client area
                      ShowWindow hWnd, nCmdShow
                      UpdateWindow hWnd
                    
                      ' Main message loop of program.
                      ' Acquire and dispatch messages until a WM_QUIT message is received.
                      WHILE GetMessage(tmsg, BYVAL %NULL, 0, 0) > 0
                        IF IsDialogMessage(hWnd, tmsg) = 0 THEN
                          TranslateMessage tmsg
                          DispatchMessage tmsg
                        END IF
                      WEND
                    
                      ' NOTE: This should not be called by the window hosting the control.
                      '       This function should be called when the DLL receives the
                      '       DLL_PROCESS_DETACH notification.
                      UnRegisterLookup
                    
                      FUNCTION = tmsg.wParam
                    
                    END FUNCTION
                    
                    '-------------------------------------------------------------------------------
                    '
                    ' PROCEDURE: Form1_WndProc
                    ' PURPOSE:   Processes messages for the Form1 window.
                    '
                    '-------------------------------------------------------------------------------
                    
                    FUNCTION Form1_WndProc _
                      ( _
                      BYVAL hWnd    AS DWORD, _ ' window handle
                      BYVAL uMsg    AS DWORD, _ ' type of message
                      BYVAL wParam  AS DWORD, _ ' first message parameter
                      BYVAL lParam  AS LONG _   ' second message parameter
                      ) EXPORT AS LONG
                    
                      LOCAL hWndChild     AS DWORD    ' handle of child window
                      LOCAL hFont         AS DWORD    ' handle of font used by form
                    
                      SELECT CASE uMsg
                        CASE %WM_COMMAND
                    
                        CASE %WM_DESTROY
                          PostQuitMessage 0
                          FUNCTION = %FALSE
                          EXIT FUNCTION
                    
                        CASE %WM_CREATE
                          ' Create font used by container
                          hFont = GetStockObject(%DEFAULT_GUI_FONT)
                    
                          ' Create the Container window
                          hWndChild = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_CONTROLPARENT, _         ' extended styles
                                                     "Lookup", _                                          ' class name
                                                     "", _                                                ' caption
                                                     %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER OR _          ' window styles
                                                     %WS_CLIPCHILDREN OR %WS_TABSTOP, _
                                                     12, 41, _                                            ' left, top
                                                     211, 23, _                                           ' width, height
                                                     hWnd, %IDC_FORM1_CONTAINER, _                        ' handle of parent, control ID
                                                     ghInstance, BYVAL %NULL)                             ' handle of instance, creation parameters
                          SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
                    
                          ' Subclass the Lookup control
                          SetProp hWndChild, "OLDWNDPROC", SetWindowLong(hWndChild, %GWL_WNDPROC, CODEPTR(Container_SubclassProc))
                    
                          ' Create the OK text button
                          hWndChild = CreateWindowEx(0, _                                                 ' extended styles
                                                     "Button", _                                          ' class name
                                                     "OK", _                                              ' caption
                                                     %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _         ' window styles
                                                     %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _       ' class styles
                                                     134, 156, _                                          ' left, top
                                                     75, 23, _                                            ' width, height
                                                     hWnd, %IDOK, _                                       ' handle of parent, control ID
                                                     ghInstance, BYVAL %NULL)                             ' handle of instance, creation parameters
                          SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
                    
                          FUNCTION = %FALSE
                          EXIT FUNCTION
                      END SELECT
                    
                      FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
                    
                    END FUNCTION
                    
                    '-------------------------------------------------------------------------------
                    '
                    ' PROCEDURE: Container_SubclassProc
                    ' PURPOSE:   Processes messages for the subclassed Lookup window.
                    '
                    '-------------------------------------------------------------------------------
                    
                    FUNCTION Container_SubclassProc _
                      ( _
                      BYVAL hWnd    AS DWORD, _ ' control handle
                      BYVAL uMsg    AS DWORD, _ ' type of message
                      BYVAL wParam  AS DWORD, _ ' first message parameter
                      BYVAL lParam  AS LONG _   ' second message parameter
                      ) EXPORT AS LONG
                    
                      LOCAL lpOldWndProc    AS DWORD    ' address of original window procedure
                    
                      lpOldWndProc = GetProp(hWnd, "OLDWNDPROC")
                    
                      SELECT CASE uMsg
                        CASE %WM_COMMAND
                    
                        CASE %WM_DESTROY
                          ' Remove control subclassing
                          SetWindowLong hWnd, %GWL_WNDPROC, RemoveProp(hWnd, "OLDWNDPROC")
                      END SELECT
                    
                      FUNCTION = CallWindowProc(lpOldWndProc, hWnd, uMsg, wParam, lParam)
                    
                    END FUNCTION
                    
                    '===============================================================================
                    '-------------------------- [Custom control code] ------------------------------
                    '===============================================================================
                    
                    TYPE LookupData
                      hWndEdit  AS DWORD
                      hWndBtn   AS DWORD
                    END TYPE
                    
                    '-------------------------------------------------------------------------------
                    
                    FUNCTION RegisterLookup () AS LONG
                    
                      LOCAL szClassName   AS WSTRINGZ * %MAX_PATH   ' class name
                      LOCAL twcx          AS WNDCLASSEX             ' class information
                    
                      ' Register the Container window
                      szClassName        = "Lookup"
                      twcx.cbSize        = SIZEOF(twcx)                               ' size of WNDCLASSEX structure
                      twcx.style         = %CS_DBLCLKS OR %CS_GLOBALCLASS             ' class styles
                      twcx.lpfnWndProc   = CODEPTR(Container_WndProc)                 ' address of window procedure used by class
                      twcx.cbClsExtra    = 0                                          ' extra class bytes
                      twcx.cbWndExtra    = 4                                          ' extra window bytes
                      twcx.hInstance     = GetModuleHandle(BYVAL %NULL)               ' instance of the process that is registering the window
                      twcx.hIcon         = %NULL                                      ' handle of class icon
                      twcx.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
                      twcx.hbrBackground = %COLOR_BTNFACE + 1                         ' brush used to fill background of window's client area
                      twcx.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
                      twcx.lpszClassName = VARPTR(szClassName)                        ' class name
                      twcx.hIconSm       = %NULL                                      ' handle of small icon shown in caption/system Taskbar
                    
                      FUNCTION = RegisterClassEx(twcx)
                    
                    END FUNCTION
                    
                    '-------------------------------------------------------------------------------
                    
                    FUNCTION UnregisterLookup () AS LONG
                    
                      LOCAL szClassName   AS WSTRINGZ * %MAX_PATH   ' class name
                    
                      szClassName = "Lookup"
                      UnregisterClass szClassName, GetModuleHandle(BYVAL %NULL)
                    
                    END FUNCTION
                    
                    '-------------------------------------------------------------------------------
                    '
                    ' PROCEDURE: Container_WndProc
                    ' PURPOSE:   Processes messages for the Container window.
                    '
                    '-------------------------------------------------------------------------------
                    
                    FUNCTION Container_WndProc _
                      ( _
                      BYVAL hWnd    AS DWORD, _ ' window handle
                      BYVAL uMsg    AS DWORD, _ ' type of message
                      BYVAL wParam  AS DWORD, _ ' first message parameter
                      BYVAL lParam  AS LONG _   ' second message parameter
                      ) EXPORT AS LONG
                    
                      LOCAL szItem        AS WSTRINGZ * %MAX_PATH
                      LOCAL tsize         AS SIZEL
                      LOCAL pLookup       AS LookupData PTR         ' ponter to control data
                      LOCAL hWndChild     AS DWORD                  ' handle of child window
                      LOCAL hFont         AS DWORD                  ' handle of font used by panel
                      LOCAL hDC           AS DWORD
                      LOCAL dx            AS LONG
                      LOCAL cxButton      AS LONG
                    
                      SELECT CASE uMsg
                        CASE %WM_COMMAND
                    
                        CASE %WM_SETFOCUS
                          pLookup = GetWindowLong(hWnd, 0)
                    
                          ' Set the keyboard focus to the child edit control
                          SetFocus @pLookup.hWndEdit
                    
                        CASE %WM_SIZE
                          pLookup = GetWindowLong(hWnd, 0)
                    
                          ' Size the children of our custom control
                          hDC = GetDC(%NULL)
                          szItem = "..."
                          GetTextExtentPoint32 hDC, szItem, LEN(szItem), tsize
                          ReleaseDC %NULL, hDC
                          dx = GetSystemMetrics(%SM_CXFIXEDFRAME)
                          cxButton = dx + tsize.cx + dx
                          SetWindowPos @pLookup.hWndBtn, %NULL, LOWRD(lParam) - cxButton, 0, cxButton, HIWRD(lParam), %SWP_NOZORDER OR %SWP_NOACTIVATE
                          SetWindowPos @pLookup.hWndEdit, %NULL, 0, 0, LOWRD(lParam) - cxButton - 1, HIWRD(lParam), %SWP_NOZORDER OR %SWP_NOACTIVATE
                    
                        CASE %WM_NCDESTROY
                          pLookup = GetWindowLong(hWnd, 0)
                    
                          IF pLookup THEN
                            HeapFree GetProcessHeap(), 0, pLookup
                          END IF
                    
                        CASE %WM_PAINT
                    
                    
                        CASE %WM_CREATE
                          pLookup = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, SIZEOF(@pLookup))
                          IF pLookup = %NULL THEN
                            FUNCTION = -1
                            EXIT FUNCTION
                          END IF
                          SetWindowLong hWnd, 0, pLookup
                    
                          ' Create font used by container
                          hFont = GetStockObject(%ANSI_VAR_FONT)
                    
                          ' Create the Edit1 edit control
                          hWndChild = CreateWindowEx(%WS_EX_CLIENTEDGE, _                                 ' extended styles
                                                     "Edit", _                                            ' class name
                                                     "", _                                                ' caption
                                                     %WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR _    ' window styles
                                                     %WS_TABSTOP OR _
                                                     %ES_LEFT OR %ES_AUTOHSCROLL, _                       ' class styles
                                                     12, -2, _                                            ' left, top
                                                     63, 21, _                                            ' width, height
                                                     hWnd, -1, _                            ' handle of parent, control ID
                                                     GetModuleHandle(BYVAL %NULL), BYVAL %NULL)           ' handle of instance, creation parameters
                          ' Subclass the control
                          SetProp hWndChild, "OLDWNDPROC", SetWindowLong(hWndChild, %GWL_WNDPROC, CODEPTR(Edit_SubclassProc))
                          SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
                          @pLookup.hWndEdit = hWndChild
                    
                          ' Create the TextBtn1 text button
                          hWndChild = CreateWindowEx(0, _                                                 ' extended styles
                                                     "Button", _                                          ' class name
                                                     "...", _                                             ' caption
                                                     %WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR _    ' window styles
                                                     %WS_TABSTOP OR _
                                                     %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _       ' class styles
                                                     121, -3, _                                           ' left, top
                                                     75, 23, _                                            ' width, height
                                                     hWnd, -1, _                         ' handle of parent, control ID
                                                     GetModuleHandle(BYVAL %NULL), BYVAL %NULL)           ' handle of instance, creation parameters
                          ' Subclass the control
                          SetProp hWndChild, "OLDWNDPROC", SetWindowLong(hWndChild, %GWL_WNDPROC, CODEPTR(Button_SubclassProc))
                          SendMessage hWndChild, %WM_SETFONT, hFont, %TRUE
                          @pLookup.hWndBtn = hWndChild
                    
                          FUNCTION = %FALSE
                          EXIT FUNCTION
                      END SELECT
                    
                      FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
                    
                    END FUNCTION
                    
                    '-------------------------------------------------------------------------------
                    '
                    ' PROCEDURE: Edit_SubclassProc
                    ' PURPOSE:   Processes messages for the subclassed Edit window.
                    '
                    '-------------------------------------------------------------------------------
                    
                    FUNCTION Edit_SubclassProc _
                      ( _
                      BYVAL hWnd    AS DWORD, _ ' control handle
                      BYVAL uMsg    AS DWORD, _ ' type of message
                      BYVAL wParam  AS DWORD, _ ' first message parameter
                      BYVAL lParam  AS LONG _   ' second message parameter
                      ) EXPORT AS LONG
                    
                      LOCAL lpOldWndProc    AS DWORD    ' address of original window procedure
                    
                      lpOldWndProc = GetProp(hWnd, "OLDWNDPROC")
                    
                      SELECT CASE uMsg
                        CASE %WM_DESTROY
                          ' Remove control subclassing
                          SetWindowLong hWnd, %GWL_WNDPROC, RemoveProp(hWnd, "OLDWNDPROC")
                      END SELECT
                    
                      FUNCTION = CallWindowProc(lpOldWndProc, hWnd, uMsg, wParam, lParam)
                    
                    END FUNCTION
                    
                    '-------------------------------------------------------------------------------
                    '
                    ' PROCEDURE: Button_SubclassProc
                    ' PURPOSE:   Processes messages for the subclassed Button window.
                    '
                    '-------------------------------------------------------------------------------
                    
                    FUNCTION Button_SubclassProc _
                      ( _
                      BYVAL hWnd    AS DWORD, _ ' control handle
                      BYVAL uMsg    AS DWORD, _ ' type of message
                      BYVAL wParam  AS DWORD, _ ' first message parameter
                      BYVAL lParam  AS LONG _   ' second message parameter
                      ) EXPORT AS LONG
                    
                      LOCAL lpOldWndProc    AS DWORD    ' address of original window procedure
                    
                      lpOldWndProc = GetProp(hWnd, "OLDWNDPROC")
                    
                      SELECT CASE uMsg
                        CASE %WM_DESTROY
                          ' Remove control subclassing
                          SetWindowLong hWnd, %GWL_WNDPROC, RemoveProp(hWnd, "OLDWNDPROC")
                      END SELECT
                    
                      FUNCTION = CallWindowProc(lpOldWndProc, hWnd, uMsg, wParam, lParam)
                    
                    END FUNCTION
                    Dominic Mitchell
                    Phoenix Visual Designer
                    http://www.phnxthunder.com

                    Comment

                    Working...
                    X