Tweet
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).
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
Comment