Announcement

Collapse

New Sub-Forum

In an effort to help make sure there are appropriate categories for topics of discussion that are happening, there is now a sub-forum for databases and database programming under Special Interest groups. Please direct questions, etc., about this topic to that sub-forum moving forward. Thank you.
See more
See less

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

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

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

    I am again asking for help. All other times I've had good & useful advice. I am a PB learner with VB background, so some things are much different here. Previously, I had a 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. The routine used the Got Focus event to set the parameters up for the SUB that tested keystrokes and then tested the full textbox entry when the user pressed CR or when the Lost Focus event occurred. With an invalid entry, the Lost Focus event popped up a message box with descriptive error and then returned the focus to the offending textbox. I could even monitor cut and paste operations.

    Anyway, I want to do it here in PB, and once I get it right I'd be happy to post it to the downloads with commented directions within the file.

    But I'm having a bit of a problem reading KeyDn. KeyAscii and KeyUp values. I've placed a test program below for anyone interested to patch up and make work.

    Thanks (again) very much in advance.
    Bob

    +++++++++++++++++++++++++++++++++++++++++++++++++++
    #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 = 1002
    %IDC_TEXTBOX2 = 1003
    %IDC_LABEL1 = 1004
    %IDC_LABEL2 = 1005
    #PBFORMS END CONSTANTS
    '------------------------------------------------------------------------------
    ' ** Declarations **
    '------------------------------------------------------------------------------
    DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
    DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    #PBFORMS DECLARATIONS
    '=====================================================================================================

    '=====================================================================================================
    ' ** My Globals **
    '=====================================================================================================
    GLOBAL MyDlg AS DWORD
    GLOBAL Txt AS STRING
    '=====================================================================================================

    '=====================================================================================================
    ' ** My Declarations **
    '=====================================================================================================
    DECLARE FUNCTION DispatchMessage LIB "USER32.DLL" ALIAS "DispatchMessageA" (lpMsg AS tagMSG) AS LONG
    DECLARE FUNCTION TranslateMessage LIB "USER32.DLL" ALIAS "TranslateMessage" (lpMsg AS tagMSG) AS LONG
    DECLARE FUNCTION GetMessage LIB "USER32.DLL" ALIAS "GetMessageA" (lpMsg AS tagMSG, BYVAL hWnd AS DWORD, BYVAL uMsgFilterMin AS DWORD, BYVAL uMsgFilterMax AS DWORD) AS LONG
    '------------------------------------------------------------------------------

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

    '------------------------------------------------------------------------------
    ' ** CallBacks **
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowDIALOG1Proc()
    LOCAL lpMsg AS tagMSG
    LOCAL NULL AS DWORD
    LOCAL TabChar AS STRING * 1
    LOCAL RtnChar AS STRING * 2

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

    SELECT CASE AS LONG CBMSG
    CASE %WM_INITDIALOG
    ' Initialization handler
    Txt = ""

    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_TEXTBOX2, TRIM$(Txt)

    CASE %IDC_TEXTBOX1
    SELECT CASE CBCTLMSG
    CASE %EN_SETFOCUS ' got focus event
    'msgbox "Got Focus", %MB_TASKMODAL
    Txt = Txt & "Got focus - 1" & TabChar & "CBCTLMSG=" & HEX$(CBCTLMSG) & TabChar & "CBMSG=" & HEX$(CBMSG) & RtnChar

    CALL GetMessage(lpMsg, NULL, 0, 0) ' these 3 lines are probably wrong or in in the wrong place and maybe need to be put in a loop???
    CALL TranslateMessage(lpMsg)
    CALL DispatchMessage(lpMsg)
    Txt = Txt & "Got focus - 2" & TabChar & "CBCTLMSG=" & HEX$(CBCTLMSG) & TabChar & "CBMSG=" & HEX$(CBMSG) & RtnChar
    CONTROL SET TEXT MyDlg, %IDC_TEXTBOX2, Txt

    CASE %EN_KILLFOCUS ' lost focus event
    Txt = Txt & "Lost focus" & TabChar & "CBCTLMSG=" & HEX$(CBCTLMSG) & TabChar & "CBMSG=" & HEX$(CBMSG) & RtnChar
    CONTROL SET TEXT MyDlg, %IDC_TEXTBOX2, Txt

    CASE ELSE ' I sure would like to determine KeyDn, KeyAscii and Key Up !!!!
    Txt = Txt & "Something else" & TabChar & "CBCTLMSG=" & HEX$(CBCTLMSG) & TabChar & "CBMSG=" & HEX$(CBMSG) & RtnChar
    CONTROL SET TEXT MyDlg, %IDC_TEXTBOX2, Txt
    END SELECT

    CASE %IDC_TEXTBOX2

    CASE %IDC_LABEL1

    CASE %IDC_LABEL2

    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, "This checkbox has no purpose " + _
    "other than to receive and lose focus.", 15, 12, 228, 12
    CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "", 15, 42, 114, 12, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _
    %ES_LEFT OR %ES_AUTOHSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
    %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX2, "", 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_LABEL1, "Type Input Here", 15, 33, 117, 9
    CONTROL ADD LABEL, hDlg, %IDC_LABEL2, "Receive Textbox Messages Here", 15, 63, 117, 9
    #PBFORMS END DIALOG
    MyDlg = hDlg ' Save handle to dialog
    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

    #PBFORMS BEGIN CLEANUP %IDD_DIALOG1
    #PBFORMS END CLEANUP

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

  • #2
    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:
    Engineer's Motto: If it aint broke take it apart and fix it

    "If at 1st you don't succeed... call it version 1.0"

    "Half of Programming is coding"....."The other 90% is DEBUGGING"

    "Document my code????" .... "WHYYY??? do you think they call it CODE? "

    Comment


    • #3
      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
      Michael Mattias
      Tal Systems Inc. (retired)
      Racine WI USA
      [email protected]
      http://www.talsystems.com

      Comment


      • #4
        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

        Comment


        • #5
          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

          Comment


          • #6
            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
            Rick Angell

            Comment


            • #7
              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
              '-----------------------------------------------------------------------------------------------------------------
              Adam Drake
              Drake Software

              Comment


              • #8
                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

                Comment


                • #9
                  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

                  Comment


                  • #10
                    Adminstrative notes:

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

                    re your profile... location is missing.
                    Michael Mattias
                    Tal Systems Inc. (retired)
                    Racine WI USA
                    [email protected]
                    http://www.talsystems.com

                    Comment


                    • #11
                      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
                      '-----------------------------------------------------------------------------------------------------------------
                      Rick Angell

                      Comment


                      • #12
                        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

                        Comment


                        • #13
                          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
                          '==============================================================================
                          '
                          Last edited by Mike Doty; 8 Dec 2007, 09:57 AM. Reason: Code didn't come out formatted
                          How long is an idea? Write it down.

                          Comment


                          • #14
                            '
                            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
                            '
                            How long is an idea? Write it down.

                            Comment


                            • #15
                              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

                              Comment


                              • #16
                                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.
                                Adam Drake
                                Drake Software

                                Comment


                                • #17
                                  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

                                  Comment


                                  • #18
                                    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)
                                    Adam Drake
                                    Drake Software

                                    Comment


                                    • #19
                                      Adam,

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

                                      Regards,
                                      Bob

                                      Comment


                                      • #20
                                        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

                                        Comment

                                        Working...
                                        X