Announcement

**Cliff Nichols** · 6 Dec 2007, 06:47 PM

Hi Robert, and welcome to the "Light" side of the Force instead of the VB "Dark" side

Just razzing..... Since I too am a convert of VB to PB (at first only for DLL's to speed things up, but more and more I forget VB even existed)
anyways your quote of

powerful textbox input routine that could monitor keystrokes, etc. I could set any given textbox to receive SINGLE, DOUBLE, LONG, INTEGER, STRING, etc. with limits on min, max, field length, etc.

I take this as depending on the textbox, you validate if the box was for numbers you would not allow "12C" instead of "123" or if it was for text you would not allow "C4T" instead of "CAT" ?????

I took a quick look (and thank you for compile-able code by the way) and I think I see what you are asking. But will take me a while to tear down a working idea.
If I am on the right track, what you may want to take a look at is my Source Code Forum post Virtual Keyboard that could give you an idea about subclassing the textbox for key presses (although it could still use some work, but a basic example)

Before others yell at you, here is a helpful hint about posting code. Use UBB code UBB codes explained
Basically UBB codes for posting your code online here are (take out the spaces between each letter for the real code.
[ c o d e ]
Put your source code here
[ / c o d e ]

Anyways...welcome, and hope your experience has been GREAT so far :wavey:

**Michael Mattias** · 6 Dec 2007, 07:05 PM

If you really want each keystroke, you must subclass the control and process WM_KEYUP (or WM_KEYDOWN, or WM_CHAR). Scores of examples here.

However, if what you really want to know is when the user has changed something, you can simply handle the WM_COMMAND/EN_CHANGE notification message in your dialog procedure (CBMSG=%WM_COMMAND and CBCTLMSG=EN_CHANGE and CBCTL=%ID_TEXTBOX), and you won't need to subclass the control.

MCM

**Robert Floyd** · 6 Dec 2007, 08:34 PM

Cliff Nichols - I think you have the right idea for what I am trying to do. I use a Type declaration as below to initialize each textbox variable for my character validation and value validation routines. I then only need to pass the typed variable along with the current keystroke to validate; or the current contents of the text box to validate (if lostfocus or carriage return).

For VB:
In the GotFocus event, I prep the textbox to be validated;
In the KeyAscii event I process keystrokes and discard invalid ones, or if carriage return is pressed, I validate the textbox value, issue a useful error message and reset the textbox to its original value;
In the Lost Focus event, I validate the textbox value, issue a useful error message, reset the textbox to its original value and return the focus to the textbox.

There are also provisions for cut and paste.

Code:

Type StringInput
      OldValue As String      ' previous textbox value
      DataType As String     ' "double", "long", "date", "time", "datetime", & "string" are allowed
      Max As String            ' set to vbNullString to turn off max checking
      EqMaxOk As Boolean   ' set to "True" to allow the tested value to be <= to Max, "False" for < to Max
      Min As String            ' set to vbNullString to turn off min checking
      EqMinOk As Boolean   ' set to "True" to allow the tested value to be >= to Min, "False" for > to Min
      MaxLen As Integer      ' maximum number of characters to allow, set to "0" to disable MaxLen checking
      NullStrOk As Boolean    ' set to "True" to allow the textbox to be left blank, "False" to force an entry to the textbox
End Type

Thanks again
Bob

**Robert Floyd** · 6 Dec 2007, 08:42 PM

Michael Mattias

I really do want each keystroke. I am sorry to be such a newbee, but I have looked around and not found what I am after, as I do indeed want to process WM_KEYUP, WM_KEYDOWN, and WM_CHAR. And I am so new, I don't even understand what you mean when you tell me I must must subclass the control.

If you could point me at an example or two, I would be very appreciative.

Thanks,
Bob

**Richard Angell** · 6 Dec 2007, 10:48 PM

Other than many examples in the forums there are several that came with your PB/WIN if it is version 8.0x. Two dealing wih your query are:

Samples\SubClass\SubClass.bas
Samples\DDT\Graphic\BoltCalc\BoltCalc.bas

**Adam J. Drake** · 6 Dec 2007, 10:50 PM

Code:

#PBFORMS CREATED V1.51
'-----------------------------------------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly.  See the PB/Forms documentation for
' more information.
' Named blocks begin like this:    #PBFORMS BEGIN ...
' Named blocks end like this:      #PBFORMS END ...
' Other PB/Forms metastatements such as:
'     #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'-----------------------------------------------------------------------------------------------------------------

#COMPILE EXE
#DIM ALL

'-----------------------------------------------------------------------------------------------------------------
'   ** Includes **
'-----------------------------------------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#PBFORMS END INCLUDES
'-----------------------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------------------
'   ** Constants **
'-----------------------------------------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1  =  101
%IDC_TEXTBOX1 = 1001
%IDC_LISTBOX1 = 1002    '*
%IDC_BUTTON1  = 1003
#PBFORMS END CONSTANTS
'-----------------------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------------------
'   ** Declarations **
'-----------------------------------------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'-----------------------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'-----------------------------------------------------------------------------------------------------------------
FUNCTION PBMAIN()
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'-----------------------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------------------
'   ** CallBacks **
'-----------------------------------------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            ' Initialization handler

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %IDC_TEXTBOX1

                CASE %IDC_BUTTON1
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                        DIALOG END CBHNDL
                    END IF

            END SELECT
    END SELECT
END FUNCTION
'-----------------------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------------------
'   ** Dialogs **
'-----------------------------------------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "Subclassing Example", 70, 70, 201, 26, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR _
        %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
        %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "TextBox1", 5, 5, 100, 13
    CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON1, "Exit", 125, 5, 50, 15
#PBFORMS END DIALOG

    ' A short explanation on subclassing: You are setting a new window procedure to be called first
    ' before your callback function actually gets notified of anything.

    LOCAL hWnd      AS DWORD
    LOCAL OldProc   AS LONG
    
    ' Get Handle to Control - Used for Windows API Calls
    hWnd = GetDlgItem(hDlg, %IDC_TEXTBOX1)
    
    ' Set Address for New Window Procedure
    OldProc = SetWindowLong(hWnd, %GWL_WNDPROC, CODEPTR(SubclassProc))
    
    ' Store Original Window Procedure Address as a Property on the control, so no global var is needed
    SetProp hWnd, "OldProc", OldProc

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP

    FUNCTION = lRslt
END FUNCTION
'-----------------------------------------------------------------------------------------------------------------
FUNCTION SubclassProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
    
    LOCAL OldProc   AS LONG
    LOCAL ptMsg     AS TAGMSG PTR
    
    ' Retrieve Original Window Procedure Address
    OldProc = GetProp(hWnd, "OldProc")
    
    SELECT CASE wMsg
        CASE %WM_GETDLGCODE
            ' Use this code to 'ask' for enter keypress event, by default doesn't get sent to textbox
            IF lParam THEN
                ptMsg = lParam
                IF @ptMsg.message = %WM_KEYDOWN THEN
                    IF @ptMsg.wParam = %VK_RETURN THEN
                        FUNCTION = %DLGC_WANTMESSAGE
                        EXIT FUNCTION
                    END IF
                END IF
            END IF
        CASE %WM_SETFOCUS
            ' Gotfocus event equivalent
        CASE %WM_KILLFOCUS
            ' Lostfocus event equivalent
        CASE %WM_CHAR
            ' Keyascii event equivalent, keycode value in wParam
        CASE %WM_KEYDOWN
            ' Keydown event equivalent, key value in wParam
            ' look in WIN32API.INC for equates starting with %VK_ to find the key you're looking for
        CASE %WM_KEYUP
            ' Keyup event equivalent, key value in wParam
            ' look in WIN32API.INC for equates starting with %VK_ to find the key you're looking for
        CASE %WM_CUT
            ' Process Cut provisions here
        CASE %WM_PASTE
            ' Process Paste provisions here
        CASE %WM_DESTROY
            ' Cleanup - Must reset %GWL_WNDPROC to original address, and remove property
            SetWindowLong hWnd, %GWL_WNDPROC, OldProc
            RemoveProp hWnd, "OldProc"
    END SELECT
    
    ' Pass Control to original window procedure (callback function)
    FUNCTION = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)
    
END FUNCTION
'-----------------------------------------------------------------------------------------------------------------

**Robert Floyd** · 7 Dec 2007, 10:21 AM

Wow!!

Adam J. Drake

Incredible!! Thank you so much!! I promise to study what's going on here and learn. The program demonstrates exactly what I was after.

Thanks again!
Bob Floyd

**Robert Floyd** · 7 Dec 2007, 10:22 AM

Richard Angell

Thanks so much for pointing out the examples. I will definitely be looking at them as I learn what's what in PB.

Best regards,
Bob Floyd

**Michael Mattias** · 7 Dec 2007, 10:44 AM

Adminstrative notes:

re the comment about code tags... yes you can "EDIT" your post to insert them.

re your profile... location is missing.

**Richard Angell** · 7 Dec 2007, 11:47 AM

Here's Adam's example re-worked to demo tthe concepts you are lookin for, I changed his subclass o a CALLBACK FUNCTION so you can follow itt along with some other examples.

Code:

#PBFORMS CREATED V1.51

#COMPILE EXE
#DIM ALL
'-----------------------------------------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#PBFORMS END INCLUDES
'-----------------------------------------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1  =  101
%IDC_TEXTBOX1 = 1001
%IDC_BUTTON1  = 1003
%IDC_BUTTON2  = 1004
#PBFORMS END CONSTANTS
'-----------------------------------------------------------------------------------------------------------------
'   ** Declarations **
'-----------------------------------------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'-----------------------------------------------------------------------------------------------------------------
FUNCTION PBMAIN()
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'-----------------------------------------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
    STATIC TxtInputType AS LONG
    LOCAL title AS STRING
    LOCAL hWnd,OldProc AS DWORD

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            TxtInputType = 1  'accept strings
            hWnd = GetDlgItem(CBHNDL, %IDC_TEXTBOX1)
            SetProp hWnd, "Boxtype", TxtInputType
            SetProp hWnd, "TxtLen",24
            DIALOG SET TEXT CBHNDL, "Input text type:  STRING"

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %IDC_TEXTBOX1

                CASE %IDC_BUTTON2
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                        INCR TxtInputType
                        IF TxtInputType = 11 THEN TxtInputType = 1
                        hWnd = GetDlgItem(CBHNDL, %IDC_TEXTBOX1)
                        SetProp hWnd, "Boxtype", TxtInputType
                        'arbitrary lengths of FP nums because anyone who wants to type more must have
                        'either a significant skill or a rare desire to type exceptionally long numbers
                        'as pure text ... maybe force as binary instead (grin)
                        SetProp hWnd, "TxtLen", CHOOSE&(TxtInputType,24,32,64,128,6,11,23,3,5,10)
                        title$ = "Input text type: "+ CHOOSE$(TxtInputType, "STRING", "SINGLE", "DOUBLE", "EXTENDED", _
                                             "INTEGER","LONG","QUAD","BYTE","WORD","DWORD")
                        DIALOG SET TEXT CBHNDL, title$
                        CONTROL SET TEXT CBHNDL,%IDC_TEXTBOX1,""
                        CONTROL SET FOCUS CBHNDL,%IDC_TEXTBOX1

                    END IF

                CASE %IDC_BUTTON1
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                        DIALOG END CBHNDL
                    END IF

            END SELECT
    END SELECT
END FUNCTION
'-----------------------------------------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "Subclassing Example", 525, 230, 201, 26, %WS_POPUP _
        OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
        %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
        %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
        OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "", 60, 5, 100, 13
    CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON1, "Exit", 165, 5, 30, 15
    CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON2, "Change Type", 5, 5, 50, 15
#PBFORMS END DIALOG

    LOCAL hWnd      AS DWORD
    LOCAL OldProc   AS LONG

    hWnd = GetDlgItem(hDlg, %IDC_TEXTBOX1)
    OldProc = SetWindowLong(hWnd, %GWL_WNDPROC, CODEPTR(SubclassProc))
    
    SetProp hWnd, "OldProc", OldProc

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP

    FUNCTION = lRslt
END FUNCTION
'-----------------------------------------------------------------------------------------------------------------
CALLBACK FUNCTION SubclassProc() AS LONG

    LOCAL OldProc   AS LONG
    LOCAL ptMsg     AS TAGMSG PTR
    LOCAL testtype  AS LONG
    LOCAL TxtLen    AS LONG
    LOCAL lRet, i   AS LONG
    LOCAL testchar  AS STRING
    LOCAL teststr   AS STRING
    STATIC oldstr   AS STRING
    STATIC pstchk   AS LONG

    ' Retrieve Original Window Procedure Address
    OldProc = GetProp(CBHNDL, "OldProc")
    ' Retrieve text box entry type
    testtype = GetProp(CBHNDL, "Boxtype")
    ' Retrieve text max length
    TxtLen = GetProp(CBHNDL, "TxtLen")

    SELECT CASE CBMSG
        CASE %WM_GETDLGCODE
            IF CBLPARAM THEN
                ptMsg = CBLPARAM
                IF @ptMsg.message = %WM_KEYDOWN THEN
                    IF @ptMsg.wParam = %VK_RETURN THEN
                        FUNCTION = %DLGC_WANTMESSAGE
                        EXIT FUNCTION
                    END IF
                END IF
            END IF
        CASE %WM_SETFOCUS
            DIALOG SET COLOR CBHNDL, %BLUE,%YELLOW
            DIALOG REDRAW CBHNDL
        CASE %WM_KILLFOCUS
            DIALOG SET COLOR CBHNDL, %YELLOW,%BLUE
            DIALOG REDRAW CBHNDL
        CASE %WM_CHAR
            ' Keyascii event equivalent, keycode value in wParam
            testchar = CHR$(CBWPARAM)
            GOSUB CharCheck
            ' then get the actual text
            DIALOG GET TEXT CBHNDL TO teststr
            teststr = teststr + testchar
            IF LEN(teststr) > TxtLen THEN
                BEEP
                EXIT FUNCTION
            END IF
        CASE %WM_KEYDOWN
            ' Keydown event equivalent, key value in wParam
            ' look in WIN32API.INC for equates starting with %VK_ to find the key you're looking for
        CASE %WM_KEYUP
            ' Keyup event equivalent, key value in wParam
            ' look in WIN32API.INC for equates starting with %VK_ to find the key you're looking for
            IF CBWPARAM = %VK_RETURN THEN
                DIALOG GET TEXT CBHNDL TO teststr
                ? "The Enter Key was pressed with the following value entered" +$CRLF+ _
                  "Text String: "+teststr
                DIALOG POST GetParent(CBHNDL), %WM_NextDlgCtl, _
                        GetNextDlgTabItem(GetParent(CBHNDL), CBHNDL, %FALSE), %FALSE  '%TRUE  'true for Exit Btn
                EXIT FUNCTION
            END IF
        CASE %WM_CUT
            ' Process Cut provisions here
            EXIT FUNCTION   'no cut'n up today
        CASE %WM_PASTE
            DIALOG GET TEXT CBHNDL TO oldstr
            ' Let the edit control paste the text
            lRet = CallWindowProc(OldProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
            DIALOG GET TEXT CBHNDL TO teststr
            IF LEN(teststr) > TxtLen THEN
                DIALOG SET TEXT CBHNDL, oldstr
                RESET oldstr
                BEEP
                EXIT FUNCTION
            END IF
            pstchk = 1
            FOR i& = 1 TO LEN(teststr) : testchar = MID$(teststr,i&,1) : GOSUB CharCheck : NEXT
        CASE %WM_DESTROY
            ' Cleanup - Must reset %GWL_WNDPROC to original address, and remove property
            SetWindowLong CBHNDL, %GWL_WNDPROC, OldProc
            RemoveProp CBHNDL, "TxtLen"
            RemoveProp CBHNDL, "Boxtype"
            RemoveProp CBHNDL, "OldProc"
    END SELECT

    ' Pass Control to original window procedure (callback function)
    FUNCTION = CallWindowProc(OldProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    EXIT FUNCTION
CharCheck:
    SELECT CASE AS LONG testtype
        CASE 1  'let them slide by or add your own filter here
            RETURN

        CASE 2 TO 4  'single,double,extended ... allow decimals
            IF ISFALSE INSTR("0123456789+-."+ $BS + $TAB, testchar) THEN
                BEEP
                GOTO BadInput
            END IF
        CASE 5 TO 7   'no decimals pleeeeease
            IF ISFALSE INSTR("0123456789+-"+ $BS + $TAB, testchar) THEN
                BEEP
                GOTO BadInput
            END IF
        CASE 8 TO 10
            IF ISFALSE INSTR("0123456789"+ $BS + $TAB, testchar) THEN
                BEEP
                GOTO BadInput
            END IF
    END SELECT

RETURN
BadInput:
    IF ISTRUE pstchk THEN
        DIALOG SET TEXT CBHNDL, oldstr
        RESET oldstr
        RESET pstchk
    END IF
END FUNCTION
'-----------------------------------------------------------------------------------------------------------------

**Robert Floyd** · 7 Dec 2007, 10:36 PM

More Wow!

Richard,

I'm really thrilled with all the help from you guys. I will look this code over very closely, too, particularly because of the change to a Callback function.

Best regards,
Bob

**Mike Doty** · 8 Dec 2007, 03:03 AM

Subclass using Colin Schmidt's MACROS

'

Code:

'SubClassInABox.bas
'Demonstrate simple subclassing using just a few macros.
'Key point is that it uses the internal %GWL_USERDATA storage of each
'subclassed control so that you don't have to keep track of the original
'WinProc value yourself. It is naturally thread safe and you may have
'as many subclassed controls on as many different windows as you like.
'Colin Schmidt, skyhawk76(at)yahoo.com
 
%USEMACROS = 1
#INCLUDE "Win32API.inc"
GLOBAL gCounter1 AS LONG
GLOBAL gCounter2 AS LONG
'-------------------------------------------------------------------------------
'This is the box
MACRO mSC_Set(phDlg, phCtl, pProc)
    SetWindowLong GetDlgItem(phDlg, phCtl), %GWL_USERDATA, _
        SetWindowLong(GetDlgItem(phDlg, phCtl), %GWL_WNDPROC, CODEPTR(pProc))
END MACRO
MACRO mSC_Kill(phCtl)
    SetWindowLong(GetDlgItem(CBHNDL, phCtl), %GWL_WNDPROC, _
        GetWindowLong(CBHNDL, %GWL_USERDATA))
END MACRO
MACRO mSC_OrgProc
    FUNCTION = CallWindowProc(GetWindowLong(phWnd, %GWL_USERDATA), phWnd, pdMsg, pWParam, pLParam)
END MACRO
'End of box
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'Example of using the box
%IDC_TextBox = 101
%IDC_TextBox2 = 102
%IDC_Notice = 103
 
FUNCTION TextBoxProc(BYVAL phWnd AS DWORD, BYVAL pdMsg AS DWORD, BYVAL pWParam AS DWORD, BYVAL pLParam AS LONG) AS LONG
    INCR gCounter1
    SELECT CASE AS LONG pdMsg
        CASE %WM_KEYDOWN
            CONTROL SET TEXT GetParent(phWnd), %IDC_Notice, "Key Down/ Keycode:" + STR$(pWParam) + "  gCounter1"+STR$(gCounter1)
        CASE %WM_KEYUP
            'beep
            'CONTROL SET TEXT GetParent(phWnd), %IDC_Notice, "Key Up"
        CASE ELSE
             BEEP
    END SELECT
    mSC_OrgProc
END FUNCTION
FUNCTION TextBoxProc2(BYVAL phWnd AS DWORD, BYVAL pdMsg AS DWORD, BYVAL pWParam AS DWORD, BYVAL pLParam AS LONG) AS LONG
   INCR gCounter2
    SELECT CASE AS LONG pdMsg
        CASE %WM_KEYDOWN
            CONTROL SET TEXT GetParent(phWnd), %IDC_Notice, "Key Down/ Box2:" + STR$(pWParam) + "  gCounter2"+STR$(gCounter2)
        CASE %WM_KEYUP
            'beep
            'CONTROL SET TEXT GetParent(phWnd), %IDC_Notice, "Key Up"
    END SELECT
    mSC_OrgProc
END FUNCTION
 
CALLBACK FUNCTION MainProc
    SELECT CASE AS LONG CBMSG
        CASE %WM_DESTROY
            mSC_Kill(%IDC_TextBox)
            msc_Kill(%IDC_TextBox2)
        CASE %WM_COMMAND
            SELECT CASE AS LONG CBCTL
                CASE %IDOK, %IDCANCEL
                    DIALOG END CBHNDL
            END SELECT
    END SELECT
END FUNCTION
FUNCTION PBMAIN
    LOCAL lhDlg AS DWORD
    DIALOG NEW 0, "SubClassInABox", , , 200, 195, %WS_MINIMIZEBOX OR %WS_SYSMENU TO lhDlg
    CONTROL ADD TEXTBOX, lhDlg, %IDC_TextBox, "Test Here", 10, 10, 75, 10
    CONTROL ADD TEXTBOX, lhDlg, %IDC_TextBox2,"",10,30,75,10
    CONTROL ADD LABEL, lhDlg, %IDC_Notice, "", 10, 130, 150, 20
    CONTROL ADD BUTTON, lhDlg, %IDOK, "&OK", 45, 50, 40, 14
    mSC_Set(lhDlg, %IDC_TextBox, TextBoxProc) 'subclass it
    mSC_Set(lhDlg, %IDC_TextBox2,TextBoxProc2) 'subclass this new one too
    DIALOG SHOW MODAL lhDlg CALL MainProc
END FUNCTION
'End of Example
'
'[This message has been edited by Colin Schmidt (edited October 27, 2006).]
#ENDIF
'==============================================================================
'

**Mike Doty** · 8 Dec 2007, 10:54 AM

'

Code:

' Using Colin Schmidt's code to see all messages in a LISTBOX.
' Would like to see no untrapped messages
' This might be helpful, though not finished.
#PBFORMS CREATED V1.52
#COMPILE EXE
#DIM ALL
'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1  =  101
%IDOKAY       =    1   'in win32api.inc
%IDC_TextBox1 = 1001
%IDC_LISTBOX1 = 1003
#PBFORMS END CONSTANTS
GLOBAL ghDlg     AS DWORD
'-------------------------------------------------------------------------------
'This is the box
MACRO mSC_Set(phDlg, phCtl, pProc)
    SetWindowLong GetDlgItem(phDlg, phCtl), %GWL_USERDATA, _
        SetWindowLong(GetDlgItem(phDlg, phCtl), %GWL_WNDPROC, CODEPTR(pProc))
END MACRO
MACRO mSC_Kill(phCtl)
    SetWindowLong(GetDlgItem(CBHNDL, phCtl), %GWL_WNDPROC, _
        GetWindowLong(CBHNDL, %GWL_USERDATA))
END MACRO
MACRO mSC_OrgProc
    FUNCTION = CallWindowProc(GetWindowLong(phWnd, %GWL_USERDATA), phWnd, pdMsg, pWParam, pLParam)
END MACRO
'End of box
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            ' Initialization handler
        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF
        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %IDOK
                   IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                        DIALOG END CBHNDL
                   END IF
            END SELECT
       CASE %WM_DESTROY     'always remove all subclasses
          mSC_Kill(%IDC_TextBox1)
          'msc_Kill(%IDC_TextBox2)
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    LOCAL hDlg   AS DWORD
    LOCAL hFont1 AS DWORD
    DIALOG NEW hParent, "SubClassInABox", 285, -1, 368, 562, %WS_MINIMIZEBOX _
        OR %WS_SYSMENU OR %WS_VISIBLE OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
        %DS_SETFONT, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR OR %WS_EX_CONTROLPARENT, TO hDlg
    CONTROL ADD TEXTBOX, hDlg, %IDC_TextBox1, "Test Here", 10, 10, 75, 10
    CONTROL ADD BUTTON,  hDlg, %IDOK, "&END", 15, 50, 40, 14
    'DIALOG  SEND         hDlg, %DM_SETDEFID, %IDOK, 0    'not sure what this is for?
    CONTROL ADD LISTBOX, hDlg, %IDC_LISTBOX1, , 100, 10, 250, 540, %WS_CHILD _
        OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %LBS_NOTIFY, _
        %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR
    hFont1 = PBFormsMakeFont("Courier New", 10, 400, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)
    CONTROL SEND hDlg, %IDC_LISTBOX1, %WM_SETFONT, hFont1, 0
#PBFORMS END DIALOG
   mSC_Set(hDlg, %IDC_TextBox1, TextBoxProc1)   'subclass it
   'mSC_Set(hDlg, %IDC_TextBox2, TextBoxProc2)  'if other textboxes ...
   ghDlg = hDlg
   DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
    DeleteObject hFont1
#PBFORMS END CLEANUP
    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------
 
FUNCTION TextBoxProc1(BYVAL phWnd AS DWORD, BYVAL pdMsg AS DWORD, BYVAL pWParam AS DWORD, BYVAL pLParam AS LONG) AS LONG
    STATIC gCounter1 AS DWORD
    INCR   gCounter1             'count all messages passed here
    SELECT CASE AS LONG pdMsg
        CASE %WM_KEYDOWN
            'CONTROL SET TEXT GetParent(phWnd), %IDC_Notice, "Key Down/ Keycode:" + STR$(pWParam) + "  gCounter1"+STR$(gCounter1)
            LISTBOX ADD ghDlg, %IDC_LISTBOX1, STR$(gCounter1)   + " WM_KEYDOWN/ Keycode:" + STR$(pWParam) + "   " + STR$(pLParam)
        CASE %WM_KEYUP
            'beep
            'CONTROL SET TEXT GetParent(phWnd), %IDC_Notice, "Key Up"
            LISTBOX ADD ghDlg, %IDC_LISTBOX1, STR$(gCounter1)   + " WM_KEYUP" + STR$(pWParam)     + "   " + STR$(pLParam)
         CASE %WM_CHAR
            ' Keyascii event equivalent, keycode value in wParam
              LISTBOX ADD ghDlg, %IDC_LISTBOX1, STR$(gCounter1) + " WM_CHAR" + STR$(pWParam)      + "   " + STR$(pLParam)
        CASE %WM_SETFOCUS
              LISTBOX ADD ghDlg, %IDC_LISTBOX1, STR$(gCounter1) + " WM_SETFOCUS" + STR$(pWParam)  + "   " + STR$(pLParam)
        CASE %WM_KILLFOCUS
               LISTBOX ADD ghDlg, %IDC_LISTBOX1, STR$(gCounter1)+ " WM_KILLFOCUS" + STR$(pWParam)  + "   " + STR$(pLParam)
 
        CASE ELSE   'attempting to trap all messages so this doesn't execute, not done
           LISTBOX ADD ghDlg, %IDC_LISTBOX1, STR$(gCounter1) + " UNTRAPPED" + STR$(pWParam)        + "   " + STR$(pLParam)
    END SELECT
    mSC_OrgProc
END FUNCTION
'FUNCTION TextBoxProc2(BYVAL phWnd AS DWORD, BYVAL pdMsg AS DWORD, BYVAL pWParam AS DWORD, BYVAL pLParam AS LONG) AS LONG
'
'   STATIC gCounter2 AS  DWORD
'   INCR gCounter2
'
'    mSC_OrgProc
'END FUNCTION
'

**Robert Floyd** · 9 Dec 2007, 10:04 PM

My Reworked Example is Attached

Adam & Rick - I reworked my original example program using some of your code. I moved stuff around so that I could try to work with an "array" of textboxes and slim up the code some to make it more convenient for later creation of include files. I made some good progress but hit a new problem I can't quite understand.

Mike - You might be right about me losing track of the original WinProc value (losing a thread?) I'm afraid to admit that I still don't understand too much of what you guys are telling me.

Everyone - If you run the code, you'll notice that you can:
(1) Click on tb1 and type into it and then click on the checkbox and all is well. You can then click on tb2 and type into it and then click on the checkbox and all is well. But as soon as you type on either of the two tb's, the program goes up in smoke (disappears).
(2) Click on tb1 and type into it and then click on the checkbox and all is well. But as soon as you click on tb1 again, the program goes up in smoke.
(3) tb2 does same as item (2)

Thanks everyone for your kind help.

Code:

#PBFORMS CREATED V1.51
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly.  See the PB/Forms documentation for
' more information.
' Named blocks begin like this:    #PBFORMS BEGIN ...
' Named blocks end like this:      #PBFORMS END ...
' Other PB/Forms metastatements such as:
'     #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------

#COMPILE EXE
#DIM ALL

'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1   =  101
%IDC_CHECKBOX1 = 1001
%IDC_TEXTBOX1  =  501
%IDC_TEXTBOX2  =  502
%IDC_LABEL1    = 1004
%IDC_LABEL2    = 1005
%IDC_FRAME1    = 1006
%IDC_TEXTBOX3  = 1007
%IDC_FRAME2    = 1008
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** My Constants **
'------------------------------------------------------------------------------
%FirstTbIdc    =  501
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------

'=====================================================================================================
'   ** My Types **
'=====================================================================================================
    TYPE StringInput
        hWnd AS DWORD
        TbIdc AS LONG
        InputType AS STRING * 12
        OldTxt AS STRING * 25
        Txt AS STRING * 25
    END TYPE
'=====================================================================================================

'=====================================================================================================
'   ** My Globals **
'=====================================================================================================
    GLOBAL TbInput() AS StringInput
    GLOBAL NumTbInputs AS INTEGER
    GLOBAL MyDlg AS DWORD
    GLOBAL Txt AS STRING
'=====================================================================================================

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
    NumTbInputs = 2
    DIM TbInput(1 TO NumTbInputs)

    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
    LOCAL TabChar AS STRING * 1
    LOCAL RtnChar AS STRING * 2
    LOCAL TbIndex AS LONG
    LOCAL I AS INTEGER
    LOCAL OldProc AS DWORD                                   'New

    TabChar = CHR$(9)
    RtnChar = CHR$(13) & CHR$(10)

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            ' Initialization handler
            TbInput(1).InputType = "Long"           ' Initialization all Tb's
            TbInput(2).InputType = "Float"
            TbInput(1).Txt = "abc"
            TbInput(2).Txt = "def"

            FOR I = 1 TO NumTbInputs
                TbInput(I).TbIdc = %FirstTbIdc + I - 1
                TbInput(I).hWnd = GetDlgItem(CBHNDL, TbInput(I).TbIdc)
                CONTROL SET TEXT MyDlg, TbInput(I).TbIdc, TbInput(I).Txt
                TbInput(I).OldTxt = TbInput(I).Txt
                MSGBOX "TbInput(" & FORMAT$(I) & ").hWnd=" & FORMAT$(TbInput(I).hWnd), %MB_TASKMODAL
                MSGBOX "TbInput(" & FORMAT$(I) & ").TbIdc=" & FORMAT$(TbInput(I).TbIdc), %MB_TASKMODAL
            NEXT I

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %IDC_CHECKBOX1
                    CONTROL SET TEXT MyDlg, %IDC_TEXTBOX3, TRIM$(Txt)

                CASE %IDC_TEXTBOX1 TO %IDC_TEXTBOX2                 '%IDC_TEXTBOX values need to start at 501 and continue in sequence.
                    IF CBCTLMSG = %EN_SETFOCUS THEN                 'So, %IDC_TEXTBOX1=501, %IDC_TEXTBOX2=502, etc.
                        TbIndex = CBCTL MOD 100                     'Better not have more than 100 Tb's.
                        Txt = Txt & "ShowDIALOG1Proc: Got Focus" & TabChar & "TbIndex=" & FORMAT$(TbIndex) & RtnChar
                        Txt = Txt & "ShowDIALOG1Proc: Got Focus" & TabChar & "TbInput(TbIndex).hWnd=" & FORMAT$(TbInput(TbIndex).hWnd) & RtnChar
                        CONTROL GET TEXT MyDlg, TbInput(TbIndex).TbIdc TO TbInput(TbIndex).OldTxt
                        TbInput(TbIndex).Txt = TbInput(TbIndex).OldTxt
                        SetProp TbInput(TbIndex).hWnd, "TbIndex", TbIndex
                        OldProc = SetWindowLong(TbInput(TbIndex).hWnd, %GWL_WNDPROC, CODEPTR(SubclassProc))
                        Txt = Txt & "ShowDIALOG1Proc: Got Focus" & TabChar & "OldProc=" & FORMAT$(OldProc) & RtnChar
                        SetProp TbInput(TbIndex).hWnd, "OldProc", OldProc                                                    'New
                    END IF

            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "TbInputTest", 451, 116, 396, 346, %WS_POPUP OR _
        %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
        %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
        %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
        OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX1, "Click here to update " + _
        "msg textbox, and lose focus on input boxes.", 15, 12, 228, 12
    CONTROL ADD TEXTBOX,  hDlg, %IDC_TEXTBOX1, "", 21, 39, 90, 12
    CONTROL ADD TEXTBOX,  hDlg, %IDC_TEXTBOX2, "", 132, 39, 90, 12
    CONTROL ADD TEXTBOX,  hDlg, %IDC_TEXTBOX3, "", 15, 72, 369, 258, _
        %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR _
        %WS_VSCROLL OR %ES_LEFT OR %ES_AUTOVSCROLL OR %ES_READONLY OR _
        %ES_MULTILINE, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING _
        OR %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD LABEL,    hDlg, %IDC_LABEL2, "Receive Textbox Messages Here", _
        15, 63, 117, 9
    CONTROL ADD FRAME,    hDlg, %IDC_FRAME1, "Float ", 15, 27, 105, 30
    CONTROL ADD FRAME,    hDlg, %IDC_FRAME2, "Integer ", 126, 27, 105, 30
#PBFORMS END DIALOG
    MyDlg = hDlg

    'LOCAL hWnd      AS DWORD                                                            'New
    'LOCAL OldProc   AS LONG                                                             'New

    'hWnd = GetDlgItem(hDlg, %IDC_TEXTBOX1)                                              'New
    'OldProc = SetWindowLong(hWnd, %GWL_WNDPROC, CODEPTR(SubclassProc))                  'New
    'SetProp hWnd, "OldProc", OldProc                                                    'New

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP

    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------

CALLBACK FUNCTION SubclassProc() AS LONG

    LOCAL OldProc   AS LONG
    LOCAL ptMsg     AS TAGMSG PTR
    'LOCAL testtype  AS LONG
    'LOCAL TxtLen    AS LONG
    LOCAL TbIndex   AS LONG
    'LOCAL DlgItem   AS LONG
    LOCAL lRet, i   AS LONG
    LOCAL testchar  AS STRING
    LOCAL teststr   AS STRING
    STATIC oldstr   AS STRING
    STATIC pstchk   AS LONG

    LOCAL TabChar AS STRING * 1
    LOCAL RtnChar AS STRING * 2

    TabChar = CHR$(9)
    RtnChar = CHR$(13) & CHR$(10)

    ' Retrieve Original Window Procedure Address
    OldProc = GetProp(CBHNDL, "OldProc")
    ' Retrieve text box entry type
    'testtype = GetProp(CBHNDL, "Boxtype")
    ' Retrieve text max length
    'TxtLen = GetProp(CBHNDL, "TxtLen")
    'DlgItem = GetProp(CBHNDL, "DlgItem")
    TbIndex = GetProp(CBHNDL, "TbIndex")

    SELECT CASE CBMSG
        CASE %WM_GETDLGCODE
            IF CBLPARAM THEN
                ptMsg = CBLPARAM
                IF @ptMsg.message = %WM_KEYDOWN THEN
                    IF @ptMsg.wParam = %VK_RETURN THEN
                        FUNCTION = %DLGC_WANTMESSAGE
                        EXIT FUNCTION
                    END IF
                END IF
            END IF
        CASE %WM_SETFOCUS
            Txt = Txt & "SubclassProc: Got Focus" & TabChar & "DlgItem=" & FORMAT$(TbInput(TbIndex).TbIdc) & RtnChar
            'DIALOG SET COLOR CBHNDL, %BLUE,%YELLOW
            'DIALOG REDRAW CBHNDL
        CASE %WM_KILLFOCUS
            Txt = Txt & "SubclassProc: Lost Focus" & TabChar & RtnChar
            'DIALOG SET COLOR CBHNDL, %YELLOW,%BLUE
            'DIALOG REDRAW CBHNDL
        CASE %WM_CHAR
            'Txt = Txt & "CBHNDL=" & TabChar & FORMAT$(CBHNDL) & RtnChar
            Txt = Txt & "SubclassProc:" & TabChar & "TbIndex=" & FORMAT$(TbIndex) & RtnChar
            testchar = CHR$(CBWPARAM)
            Txt = Txt & "SubclassProc:" & TabChar & "%WM_CHAR=" & FORMAT$(CBWPARAM) & TabChar & testchar & RtnChar
            ' Keyascii event equivalent, keycode value in wParam
            GOSUB CharCheck
            ' then get the actual text
            DIALOG GET TEXT CBHNDL TO teststr
            teststr = teststr + testchar
            'IF LEN(teststr) > TxtLen THEN
            '    BEEP
            '    EXIT FUNCTION
            'END IF
        CASE %WM_KEYDOWN
            ' Keydown event equivalent, key value in wParam
            ' look in WIN32API.INC for equates starting with %VK_ to find the key you're looking for
        CASE %WM_KEYUP
            ' Keyup event equivalent, key value in wParam
            ' look in WIN32API.INC for equates starting with %VK_ to find the key you're looking for
            IF CBWPARAM = %VK_RETURN THEN
                DIALOG GET TEXT CBHNDL TO teststr
                ? "The Enter Key was pressed with the following value entered" +$CRLF+ _
                  "Text String: "+teststr
                DIALOG POST GetParent(CBHNDL), %WM_NextDlgCtl, _
                        GetNextDlgTabItem(GetParent(CBHNDL), CBHNDL, %FALSE), %FALSE  '%TRUE  'true for Exit Btn
                EXIT FUNCTION
            END IF
        CASE %WM_CUT
            ' Process Cut provisions here
            EXIT FUNCTION   'no cut'n up today
        CASE %WM_PASTE
            DIALOG GET TEXT CBHNDL TO oldstr
            ' Let the edit control paste the text
            lRet = CallWindowProc(OldProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
            DIALOG GET TEXT CBHNDL TO teststr
            'IF LEN(teststr) > TxtLen THEN
            '    DIALOG SET TEXT CBHNDL, oldstr
            '    RESET oldstr
            '    BEEP
            '    EXIT FUNCTION
            'END IF
            pstchk = 1
            FOR i& = 1 TO LEN(teststr) : testchar = MID$(teststr,i&,1) : GOSUB CharCheck : NEXT
        CASE %WM_DESTROY
            ' Cleanup - Must reset %GWL_WNDPROC to original address, and remove property
            SetWindowLong CBHNDL, %GWL_WNDPROC, OldProc
            RemoveProp CBHNDL, "TbIndex"
            'RemoveProp CBHNDL, "Boxtype"
            RemoveProp CBHNDL, "OldProc"
    END SELECT

    ' Pass Control to original window procedure (callback function)
    FUNCTION = CallWindowProc(OldProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    EXIT FUNCTION
CharCheck:
    'SELECT CASE AS LONG testtype
    '    CASE 1  'let them slide by or add your own filter here
    '        RETURN
    '
    '    CASE 2 TO 4  'single,double,extended ... allow decimals
    '        IF ISFALSE INSTR("0123456789+-."+ $BS + $TAB, testchar) THEN
    '            BEEP
    '            GOTO BadInput
    '        END IF
    '    CASE 5 TO 7   'no decimals pleeeeease
    '        IF ISFALSE INSTR("0123456789+-"+ $BS + $TAB, testchar) THEN
    '            BEEP
    '           GOTO BadInput
    '        END IF
    '    CASE 8 TO 10
    '        IF ISFALSE INSTR("0123456789"+ $BS + $TAB, testchar) THEN
    '            BEEP
    '            GOTO BadInput
    '        END IF
    'END SELECT

RETURN
BadInput:
    IF ISTRUE pstchk THEN
        DIALOG SET TEXT CBHNDL, oldstr
        RESET oldstr
        RESET pstchk
    END IF
END FUNCTION

**Adam J. Drake** · 9 Dec 2007, 10:31 PM

The primary problem I see is you're actually re-subclassing the control each time it gets focus. You need to do this before the dialog is shown, and only do so once per control.

**Robert Floyd** · 10 Dec 2007, 09:14 AM

I figured it out

After sleeping on it, I figured out how to do this. I will create one TB that will be the input TB and I will keep it invisible until someone clicks on one of the other designated TB's on the form. Once a TB is selected, I will make my input TB visible, set the size and shape (CONTROL GET SIZE) and place it on top of the selected TB (CONTROL GET LOC) and give it the focus. Etc. Then the illusion of a TB array is created. I can then just revert to Adam & Rick's original code.

I'll post a (hopefully) working example in a few days.

Thanks all once again.
Bob Floyd

**Adam J. Drake** · 10 Dec 2007, 11:36 AM

Bob, you don't actually need to do that...What you can do is this...

Where you remarked out my code for subclassing, you can subclass all controls there.

Instead of using SetProp() to store the array index, you can use this:

Code:

SetWindowLong hWnd, %GWL_USERDATA, TbIndex

and inside the new "callback" or subclass procedure:

Code:

TbIndex=GetWindowLong(CBHNDL, %GWL_USERDATA)

**Robert Floyd** · 10 Dec 2007, 08:25 PM

Adam,

Thanks! I'll try that first & let you know.

Regards,
Bob

**Robert Floyd** · 11 Dec 2007, 09:22 PM

Not quite there yet

Adam,

I think I did what you said, but the second TB never enters the subclass routine. Would you mind looking it over to see whether I used your suggestion correctly? Otherwise, maybe I'd be better off using the moving TB for input.

What do you think?
Bob

Code:

#PBFORMS CREATED V1.51
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly.  See the PB/Forms documentation for
' more information.
' Named blocks begin like this:    #PBFORMS BEGIN ...
' Named blocks end like this:      #PBFORMS END ...
' Other PB/Forms metastatements such as:
'     #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------

#COMPILE EXE
#DIM ALL

'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1   =  101
%IDC_CHECKBOX1 = 1001
%IDC_TEXTBOX1  =  501
%IDC_TEXTBOX2  =  502
%IDC_LABEL1    = 1004
%IDC_LABEL2    = 1005
%IDC_FRAME1    = 1006
%IDC_TEXTBOX3  = 1007
%IDC_FRAME2    = 1008
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** My Constants **
'------------------------------------------------------------------------------
%FirstTbIdc = %IDC_TEXTBOX1
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------

'=====================================================================================================
'   ** My Types **
'=====================================================================================================
    TYPE StringInput
        hWnd AS DWORD
        TbIdc AS LONG
        MaxLen AS INTEGER
        InputType AS STRING * 12
        OldTxt AS STRING * 25
        Txt AS STRING * 25
    END TYPE
'=====================================================================================================

'=====================================================================================================
'   ** My Globals **
'=====================================================================================================
    GLOBAL TbInput() AS StringInput
    GLOBAL NumTbInputs AS INTEGER
    GLOBAL MyDlg AS DWORD
    GLOBAL Txt AS STRING
    GLOBAL TbIndex AS INTEGER
'=====================================================================================================

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
    NumTbInputs = 2
    DIM TbInput(1 TO NumTbInputs)

    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
    LOCAL TabChar AS STRING * 1
    LOCAL RtnChar AS STRING * 2
    'LOCAL TbIndex AS INTEGER

    TabChar = CHR$(9)
    RtnChar = CHR$(13) & CHR$(10)

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            ' Initialization handler
            TbInput(1).InputType = "Long"           ' Initialization all Tb's
            TbInput(2).InputType = "Float"
            TbInput(1).Txt = "abc"
            TbInput(2).Txt = "def"

            FOR TbIndex = 1 TO NumTbInputs
                TbInput(TbIndex).TbIdc = %FirstTbIdc + TbIndex - 1
                TbInput(TbIndex).hWnd = GetDlgItem(CBHNDL, TbInput(TbIndex).TbIdc)
                CONTROL SET TEXT MyDlg, TbInput(TbIndex).TbIdc, TbInput(TbIndex).Txt
                TbInput(TbIndex).OldTxt = TbInput(TbIndex).Txt
                'MSGBOX "TbInput(" & FORMAT$(TbIndex) & ").hWnd=" & FORMAT$(TbInput(TbIndex).hWnd), %MB_TASKMODAL
                'MSGBOX "TbInput(" & FORMAT$(TbIndex) & ").TbIdc=" & FORMAT$(TbInput(TbIndex).TbIdc), %MB_TASKMODAL
            NEXT TbIndex

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %IDC_CHECKBOX1
                    CONTROL SET TEXT MyDlg, %IDC_TEXTBOX3, TRIM$(Txt)

                CASE %IDC_TEXTBOX1 TO %IDC_TEXTBOX2                 '%IDC_TEXTBOX values need to start at 501 and continue in sequence.
                    IF CBCTLMSG = %EN_SETFOCUS THEN                 'So, %IDC_TEXTBOX1=501, %IDC_TEXTBOX2=502, etc.
                        TbIndex = CBCTL MOD 100                     'Better not have more than 100 Tb's.
                        Txt = Txt & "ShowDIALOG1Proc: Got Focus" & TabChar & "TbIndex=" & FORMAT$(TbIndex) & RtnChar
                        Txt = Txt & "ShowDIALOG1Proc: Got Focus" & TabChar & "TbInput(TbIndex).hWnd=" & FORMAT$(TbInput(TbIndex).hWnd) & RtnChar
                        CONTROL GET TEXT MyDlg, TbInput(TbIndex).TbIdc TO TbInput(TbIndex).OldTxt
                        'TbInput(TbIndex).Txt = TbInput(TbIndex).OldTxt
                        SetWindowLong TbInput(TbIndex).hWnd, %GWL_USERDATA, TbIndex
                    END IF

            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "TbInputTest", 451, 116, 396, 346, %WS_POPUP OR _
        %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
        %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
        %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
        OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX1, "Click here to update " + _
        "msg textbox, and lose focus on input boxes.", 15, 12, 228, 12
    CONTROL ADD TEXTBOX,  hDlg, %IDC_TEXTBOX1, "", 21, 39, 90, 12
    CONTROL ADD TEXTBOX,  hDlg, %IDC_TEXTBOX2, "", 132, 39, 90, 12
    CONTROL ADD TEXTBOX,  hDlg, %IDC_TEXTBOX3, "", 15, 72, 369, 258, _
        %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR _
        %WS_VSCROLL OR %ES_LEFT OR %ES_AUTOVSCROLL OR %ES_READONLY OR _
        %ES_MULTILINE, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING _
        OR %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD LABEL,    hDlg, %IDC_LABEL2, "Receive Textbox Messages Here", _
        15, 63, 117, 9
    CONTROL ADD FRAME,    hDlg, %IDC_FRAME1, "Float ", 15, 27, 105, 30
    CONTROL ADD FRAME,    hDlg, %IDC_FRAME2, "Integer ", 126, 27, 105, 30
#PBFORMS END DIALOG
    MyDlg = hDlg

    LOCAL hWnd      AS DWORD                                                            'New
    LOCAL OldProc   AS LONG                                                             'New

    hWnd = GetDlgItem(hDlg, %IDC_TEXTBOX1)                                              'New
    OldProc = SetWindowLong(hWnd, %GWL_WNDPROC, CODEPTR(SubclassProc))                  'New
    SetProp hWnd, "OldProc", OldProc                                                    'New
    SetWindowLong hWnd, %GWL_USERDATA, TbIndex

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP

    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------

CALLBACK FUNCTION SubclassProc() AS LONG

    LOCAL OldProc   AS LONG
    LOCAL ptMsg     AS TAGMSG PTR
    LOCAL TbIndex   AS LONG
    LOCAL lRet, i   AS LONG
    LOCAL testchar  AS STRING
    LOCAL teststr   AS STRING
    STATIC oldstr   AS STRING
    STATIC pstchk   AS LONG

    LOCAL TabChar AS STRING * 1
    LOCAL RtnChar AS STRING * 2

    TabChar = CHR$(9)
    RtnChar = CHR$(13) & CHR$(10)

    
    OldProc = GetProp(CBHNDL, "OldProc")                'Retrieve Original Window Procedure Address
    TbIndex = GetWindowLong(CBHNDL, %GWL_USERDATA)      'Retrieve TbIndex

    SELECT CASE CBMSG
        CASE %WM_GETDLGCODE
            IF CBLPARAM THEN
                ptMsg = CBLPARAM
                IF @ptMsg.message = %WM_KEYDOWN THEN
                    IF @ptMsg.wParam = %VK_RETURN THEN
                        FUNCTION = %DLGC_WANTMESSAGE
                        EXIT FUNCTION
                    END IF
                END IF
            END IF
        CASE %WM_SETFOCUS
            Txt = Txt & "SubclassProc: Got Focus" & TabChar & "DlgItem=" & FORMAT$(TbInput(TbIndex).TbIdc) & RtnChar
            'DIALOG SET COLOR CBHNDL, %BLUE,%YELLOW
            'DIALOG REDRAW CBHNDL
        CASE %WM_KILLFOCUS
            Txt = Txt & "SubclassProc: Lost Focus" & TabChar & RtnChar
            'DIALOG SET COLOR CBHNDL, %YELLOW,%BLUE
            'DIALOG REDRAW CBHNDL
        CASE %WM_CHAR
            'Txt = Txt & "CBHNDL=" & TabChar & FORMAT$(CBHNDL) & RtnChar
            Txt = Txt & "SubclassProc:" & TabChar & "TbIndex=" & FORMAT$(TbIndex) & RtnChar
            testchar = CHR$(CBWPARAM)
            Txt = Txt & "SubclassProc:" & TabChar & "%WM_CHAR=" & FORMAT$(CBWPARAM) & TabChar & testchar & RtnChar
            ' Keyascii event equivalent, keycode value in wParam
            GOSUB CharCheck
            ' then get the actual text
            DIALOG GET TEXT CBHNDL TO teststr
            teststr = teststr + testchar
            'IF LEN(teststr) > TxtLen THEN
            '    BEEP
            '    EXIT FUNCTION
            'END IF
        CASE %WM_KEYDOWN
            ' Keydown event equivalent, key value in wParam
            ' look in WIN32API.INC for equates starting with %VK_ to find the key you're looking for
        CASE %WM_KEYUP
            ' Keyup event equivalent, key value in wParam
            ' look in WIN32API.INC for equates starting with %VK_ to find the key you're looking for
            IF CBWPARAM = %VK_RETURN THEN
                DIALOG GET TEXT CBHNDL TO teststr
                ? "The Enter Key was pressed with the following value entered" +$CRLF+ _
                  "Text String: "+teststr
                DIALOG POST GetParent(CBHNDL), %WM_NextDlgCtl, _
                        GetNextDlgTabItem(GetParent(CBHNDL), CBHNDL, %FALSE), %FALSE  '%TRUE  'true for Exit Btn
                EXIT FUNCTION
            END IF
        CASE %WM_CUT
            ' Process Cut provisions here
            EXIT FUNCTION   'no cut'n up today
        CASE %WM_PASTE
            DIALOG GET TEXT CBHNDL TO oldstr
            ' Let the edit control paste the text
            lRet = CallWindowProc(OldProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
            DIALOG GET TEXT CBHNDL TO teststr
            'IF LEN(teststr) > TxtLen THEN
            '    DIALOG SET TEXT CBHNDL, oldstr
            '    RESET oldstr
            '    BEEP
            '    EXIT FUNCTION
            'END IF
            pstchk = 1
            FOR i& = 1 TO LEN(teststr) : testchar = MID$(teststr,i&,1) : GOSUB CharCheck : NEXT
        CASE %WM_DESTROY
            ' Cleanup - Must reset %GWL_WNDPROC to original address, and remove property
            SetWindowLong CBHNDL, %GWL_WNDPROC, OldProc
            RemoveProp CBHNDL, "TbIndex"
            'RemoveProp CBHNDL, "Boxtype"
            RemoveProp CBHNDL, "OldProc"
    END SELECT

    ' Pass Control to original window procedure (callback function)
    FUNCTION = CallWindowProc(OldProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    EXIT FUNCTION
CharCheck:
    'SELECT CASE AS LONG testtype
    '    CASE 1  'let them slide by or add your own filter here
    '        RETURN
    '
    '    CASE 2 TO 4  'single,double,extended ... allow decimals
    '        IF ISFALSE INSTR("0123456789+-."+ $BS + $TAB, testchar) THEN
    '            BEEP
    '            GOTO BadInput
    '        END IF
    '    CASE 5 TO 7   'no decimals pleeeeease
    '        IF ISFALSE INSTR("0123456789+-"+ $BS + $TAB, testchar) THEN
    '            BEEP
    '           GOTO BadInput
    '        END IF
    '    CASE 8 TO 10
    '        IF ISFALSE INSTR("0123456789"+ $BS + $TAB, testchar) THEN
    '            BEEP
    '            GOTO BadInput
    '        END IF
    'END SELECT

RETURN
BadInput:
    IF ISTRUE pstchk THEN
        DIALOG SET TEXT CBHNDL, oldstr
        RESET oldstr
        RESET pstchk
    END IF
END FUNCTION

----------------------

Changing subjects, I think I have some nice code for handling radio buttons, but maybe this is old news to everyone. And, I have a simple include file for handling ini files, which I prefer over messing with the registry. But maybe this is old news, too, or of little interest anymore. But I could post them in the code forum if it seems like a good idea. Please let me know so I don't embarrass myself writing old news.

Thanks,
Bob

Announcement

How do I read individual keystrokes within a textbox - test code attached

How do I read individual keystrokes within a textbox - test code attached

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment