Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Process Currency Values on a Textbox without sub or superclassing

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

  • PBWin Process Currency Values on a Textbox without sub or superclassing

    I use this code to enter punctuated currency values.

    It does not use superclassing nor subclassing.

    Hope it might help.

    I make use of a dedicated CALLBACK for the TEXTBOX but it can be easily changed to work with the dialog callback (simply cut and paste).

    Code:
    #COMPILE EXE
    #DIM ALL
    
    %TRUE                 = 1
    %FALSE                = 0
    %BM_CLICK             = &HF5
    
    ' Edit Control Messages
    %EM_GETSEL            = &HB0
    %EM_SETSEL            = &HB1
    %EM_GETLINECOUNT      = &HBA
    %EM_LIMITTEXT         = &HC5
    
    %IDD_DIALOG1          =  101
    %IDC_TEXTBOX1         = 1001
    %IDC_BUTTON_ANYBUTTON = 1002
    
    
    FUNCTION PBMAIN()
         ShowDIALOG1 %HWND_DESKTOP
    END FUNCTION
    
    
    CALLBACK FUNCTION ShowDIALOG1Proc()
    
    
         SELECT CASE AS LONG CB.MSG
              CASE %WM_INITDIALOG
                   ' Initialization handler
    
              CASE %WM_COMMAND
                   ' Process control notifications
                   SELECT CASE AS LONG CB.CTL
    
                        CASE %IDC_BUTTON_ANYBUTTON
                             IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                                  MSGBOX "%IDC_BUTTON_ANYBUTTON=" + FORMAT$(%IDC_BUTTON_ANYBUTTON), %MB_TASKMODAL
                             END IF
                   END SELECT
         END SELECT
    END FUNCTION
    
    CALLBACK FUNCTION TEXTBOX1Proc()
    
    
         SELECT CASE AS LONG CB.MSG
              CASE %WM_INITDIALOG
                   ' Initialization handler
    
              CASE %WM_COMMAND
                   ' Process control notifications
                   SELECT CASE AS LONG CB.CTL
    
                        CASE %IDC_TEXTBOX1
    
                             ProcessCurrencyValue CB.HNDL, CB.CTL, CB.CTLMSG
    
                   END SELECT
         END SELECT
    END FUNCTION
    
    '----------------------------------------------------------------------------------------------------------------------------------------------------
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
         LOCAL lRslt AS LONG
         LOCAL GetItemStatus AS DWORD
    #PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
         LOCAL hDlg  AS DWORD
    
         DIALOG NEW hParent, "Dialog1", 70, 70, 201, 121, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
              %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR %DS_CENTER, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING _
              OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
    
         ' %ES_MULTILINE, %ES_AUTOVSCROLL and %ES_WANTRETURN  allows to detect when the RETURN key is pressed ($CR and $LF))
         ' Fn Keys are not detected by the filtering routine. Neither are Esc, TAB and other control keys.
    
         ' Don't forget to use the %ES_MULTILINE style in order for this to work
         CONTROL ADD TEXTBOX,  hDlg, %IDC_TEXTBOX1, "0,00", 50, 50, 100, 13, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_CENTER OR %ES_MULTILINE OR _
              %ES_AUTOVSCROLL OR %ES_UPPERCASE OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, CALL TEXTBOX1Proc
    
    
         CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON_ANYBUTTON, "ANYBUTTON", 80, 85, 50, 15
    
    
         DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
    
         FUNCTION = lRslt
    END FUNCTION
    '----------------------------------------------------------------------------------------------------------------------------------------------------
    
    SUB ProcessCurrencyValue (hDlg AS DWORD, ControlId AS LONG, Controlmsg AS LONG)
    
         DIM Temp       AS LOCAL STRING
         DIM TBStart    AS LOCAL INTEGER
         DIM TBEnd      AS LOCAL INTEGER
         DIM lResult    AS LOCAL LONG
    
         DIM Monto AS CUX
         DIM PreTemp AS STRING
         DIM PostTemp AS STRING
    
         ' deselect all text when it gets focus and place the caret at the right
         ' This is necesary because we don't want to let dots and commas to be in the textbox
         ' if the user press them at the beginning of the textbox.
         IF Controlmsg& = %EN_SETFOCUS THEN
            CONTROL POST hDlg, ControlId&, %EM_SETSEL, -2, -2
         END IF
    
         ' If enter (RETURN) was pressed, we remove the CR and LF characters from the text
         ' and take another action. In this example, just press a button
    
         ' Retrieve new text
         CONTROL GET TEXT hDlg, ControlId& TO Temp$
         Temp$ = TRIM$(Temp$)
    
         ' If the text in the textbox is deletd, put a mask in it (0,00) and move the cursor to the right
         IF LEN(Temp$) = 0 THEN
              Temp$ = "0,00"
              CONTROL POST hDlg, ControlId&, %EM_SETSEL, -2, -2
         END IF
    
    
         ' Testing for $CRLF (ENTER Key pressed!)
         lResult& = INSTR(Temp$,$CRLF)
    
         IF lResult& THEN
              ' Filter out CR and LF
              REPLACE $CRLF WITH "" IN Temp$
              ' Put it back in Editbox
              CONTROL SET TEXT hDlg, ControlId&, Temp$
              ' Put caret at the end
              CONTROL SEND hDlg, ControlId&, %EM_SETSEL, 0, -1 ' select all text
              CONTROL SEND hDlg, ControlId&, %EM_SETSEL, -1, -1 ' deselect text
              ' Set focus to button and press it!
              CONTROL SET FOCUS hDlg, %IDC_BUTTON_ANYBUTTON
              CONTROL SEND hDlg, %IDC_BUTTON_ANYBUTTON , %BM_CLICK, 0, 0
         END IF
    
    
         ' Once a key is pressed on the keyboard, it is inserted into the text in the textbox
         ' Save the values of the Textbox at this point (on entry)
    
    
         ' Check for characters not allowed and filter them out if found (only letters are allowed)
         IF TBFilterUnwanted (Temp$) THEN
    
             ' If a character other than a letter was in the variable Temp$ was shortened by one character
             ' (the not allowed one) and placed again into the Textbox.
             ' First we take note of the caret position
              CONTROL SEND hDlg, ControlId&, %EM_GETSEL, VARPTR(TBStart), VARPTR(TBEnd)
    
             ' Put Temp$ back in the Textbox
              CONTROL SET TEXT hDlg, ControlId&, Temp$
             ' Place caret at right pos
             CONTROL SEND hDlg, ControlId&, %EM_SETSEL, TBStart-1, TBEnd-1
    
         ELSE
    
             ' First we take note of the caret position
              CONTROL SEND hDlg, ControlId&, %EM_GETSEL, VARPTR(TBStart), VARPTR(TBEnd)
    
             ' Check for "0," leading all characters in the textbox and remove it before further processing
             ' Remove the colon and the dot also
    
             IF LEFT$(Temp$,2) = "0," THEN
                 Temp$ = REMOVE$ (Temp$, "0,")
             END IF
    
             Temp$ = REMOVE$ (Temp$, ANY ".,")
    
             SELECT CASE LEN(Temp$)
                   CASE 0
                        EXIT IF
                   CASE 1
                        Temp$ = "0,0" + Temp$
                        CONTROL SET TEXT hDlg, ControlId&, Temp$
                        ' Place caret at right pos
                        CONTROL SEND hDlg, ControlId&, %EM_SETSEL, TBStart+2, TBEnd+2
                        EXIT IF
    
                   CASE 2
                        Temp$ = "0," + Temp$
                        CONTROL SET TEXT hDlg, ControlId&, Temp$
                        ' Place caret at right pos
                        CONTROL SEND hDlg, ControlId&, %EM_SETSEL, TBStart+1, TBEnd+1
                        EXIT IF
    
    
                   CASE ELSE
                        PreTemp$ = LEFT$(Temp$, LEN(Temp$)-2)
                        PostTemp$ = RIGHT$(Temp$, 2)
                        Temp$ = PreTemp$ + "." + PostTemp$
    
             END SELECT
    
             ' Format the string and Put Temp$ back in the Textbox
              CONTROL SET TEXT hDlg, ControlId&, FORMAT$(VAL(Temp$),"#,###.00")
    
    '         ' Use this instead for spanish punctuation:
    '          CONTROL SET TEXT hDlg, ControlId&, NotacionMetricaF(FORMAT$(VAL(Temp$),"#,###.00"))
    
             ' Place caret at right pos
             CONTROL SEND hDlg, ControlId&, %EM_SETSEL, TBStart+1, TBEnd+1
         END IF
    
    END SUB
    
    
    FUNCTION TBFilterUnwanted (Value$) AS LONG
        LOCAL Original AS STRING
    
         ' Store the string for later comparison
         Original$ = Value$
    
         ' Filter out undesired characters
         Value$ = RETAIN$(Value$, ANY "1234567890.," + $CRLF)
         Value$ = TRIM$(Value$)
    
         ' Notify as needed
         IF Original$ <> Value$ THEN
              FUNCTION = %TRUE        ' A non-wanted caharacter was found and removed
              BEEP
         ELSE
              FUNCTION = %FALSE       ' No characters were removed from the original text
         END IF
    
    END FUNCTION
    
    
    ' For Spanish notation use this function
    FUNCTION NotacionMetricaF (Cadena AS STRING) AS STRING
    
         ' This function changes dot to comma, and comma to dot to display a number in Spanish format
         ' eg: (english form) 1,234.09 => (spanish form) 1.234,09
        REPLACE "." WITH "ççç" IN Cadena$
        REPLACE "," WITH "." IN Cadena$
        REPLACE "ççç" WITH "," IN Cadena$
    
        FUNCTION = Cadena$
    END FUNCTION
    Francisco J Castanedo
    Software Developer
    Distribuidora 3HP, C.A.
    [URL]http://www.distribuidora3hp.com[/URL]

  • #2
    HI Francisco
    Thanks

    Comment

    Working...
    X