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