This module allows the programmer to add an editmask to a StringGadget. (Copy/paste is also working)
It is also very easy to add your own symbols that can be used in the mask.
Code: Select all
Declare.b SetSymbol(Symbol.c, fValidate.funcValidateChar, fConvert.funcConvertChar = #Null)- Symbol: the character to be used in the mask
fValidate: this function contains the validation rules (e.g. allow only numeric chars)
fConvert: this function will convert the character (e.g. convert chars to uppercase).
Any feedback is welcome.
Enjoy!
24/05/2016 : new minor version
Mask is shown as tooltip.
Example has been modfied.
Code: Select all
DeclareModule LSMASK
Enumeration
#EDITMASK = 1
EndEnumeration
Prototype.b funcValidateChar(c.c)
Prototype.c funcConvertChar(c.c)
Declare.b IsReadOnly(Gadget)
Declare.i GetGadgetAttributeEx(Gadget, Attribute)
Declare SetGadgetAttributeEx(Gadget, Attribute, Value)
Declare.b SetSymbol(Symbol.c, fValidate.funcValidateChar, fConvert.funcConvertChar = #Null)
EndDeclareModule
Module LSMASK
Macro GetSel(a, b) : SendMessage_(*this\hWnd, #EM_GETSEL, @a, @b) : EndMacro
Macro SetSel(a, b) : SendMessage_(*this\hWnd, #EM_SETSEL, a, b) : EndMacro
Macro ReplaceSel(a, b) : SendMessage_(*this\hWnd, #EM_REPLACESEL, a, b) : EndMacro
Macro _istprint(a) : (a >= 32 And a < 256) : EndMacro
Macro _istdigit(a) : (a> 47 And a < 58 ) : EndMacro
Structure S_SYMBOL
cSymbol.c
funcValidate.funcValidateChar
funcConvert.funcConvertChar
EndStructure
Structure S_STRINGGADGET
hWnd.i ; windows handle
OrgProc.i ; original window procedure
PB_ID.i ; Purebasic Gadget ID
sMask.s
EndStructure
Global NewList lstSymbols.S_SYMBOL()
#EDITMASK_PROP = "LS_EDITMASK"
;// Returns the control's value in a valid format.
Procedure.s GetValidText(*this.S_STRINGGADGET)
Define.s lRes, sText
sText = GetGadgetText(*this\PB_ID)
iMaskLen = Len(*this\sMask)
If iMaskLen <= 0 Or ListSize(lstSymbols()) = 0
;// If the mask is empty, allow anything
ProcedureReturn sText
EndIf
;// Accomodate the text to the mask as much as possible
For iPos = 1 To Len(sText)
iMaskPos + 1
c = Asc(Mid(sText, iPos, 1))
If iMaskPos < iMaskLen
cMask = Asc(Mid(*this\sMask, iMaskPos, 1))
Else
cMask = 0
EndIf
;// If we've reached the end of the mask, break
If (cMask = 0)
Break
EndIf
;// Match the character to any of the symbols
ForEach lstSymbols()
;// Find the symbol that applies For the given character
If lstSymbols()\cSymbol <> cMask Or lstSymbols()\funcValidate(c) = #False
Continue
EndIf
;// Try To add matching characters in the mask Until a different symbol is reached
While iMaskPos < iMaskLen
cMask = Asc(Mid(*this\sMask, iMaskPos, 1))
If lstSymbols()\cSymbol = cMask
If lstSymbols()\funcConvert
lRes + Chr(lstSymbols()\funcConvert(c) )
Else
lRes + Chr(c)
EndIf
Break
EndIf
iMaskPos + 1
Wend
Break
Next
Next
ProcedureReturn lRes
EndProcedure
; // Redraws the window's text.
Procedure Redraw(*this.S_STRINGGADGET)
Define.s sText
sText = GetValidText(*this)
If sText <> GetGadgetText(*this\PB_ID)
SetGadgetText(*this\PB_ID, sText)
EndIf
EndProcedure
;// Pastes the text from the clipboard onto the current selection.
Procedure.i OnPaste(*this.S_STRINGGADGET, uMsg, wParam, lParam)
Protected iStart.i, iEnd.i, sText.s, lRes.i
GetSel(iStart, iEnd)
lRes = CallWindowProc_(*this\OrgProc, *this\hWnd, uMsg, wParam, lParam)
sText = GetValidText(*this)
If sText <> GetGadgetText(*this\PB_ID)
SetGadgetText(*this\PB_ID, sText)
SetSel(iStart, iEnd)
EndIf
ProcedureReturn 0
EndProcedure
;// Clears the current selection.
Procedure.i OnClear(*this.S_STRINGGADGET, uMsg, wParam, lParam)
Define.i iStart, iEnd
GetSel(iStart, iEnd)
If (iStart < iEnd)
SendMessage_(*this\hWnd, #WM_KEYDOWN, #VK_DELETE, 0)
EndIf
ProcedureReturn 0
EndProcedure
;// Handles the WM_SETTEXT message to ensure that text (set via SetWindowText) is valid.
Procedure.i OnSetText(*this.S_STRINGGADGET, uMsg, wParam, lParam)
Protected lRes.i, sText.s
lRes = CallWindowProc_(*this\OrgProc, *this\hWnd, uMsg, wParam, lParam)
sText = GetValidText(*this)
If sText <> PeekS(lParam)
SetGadgetText(*this\PB_ID, sText)
EndIf
ProcedureReturn lRes
EndProcedure
; // Cuts the current selection into the clipboard.
Procedure.i OnCut(*this.S_STRINGGADGET, uMsg, wParam, lParam)
Protected iStart.i, iEnd.i
GetSel(iStart, iEnd)
If (iStart < iEnd)
SendMessage_(*this\hWnd, #WM_COPY, 0, 0)
SendMessage_(*this\hWnd, #EM_REPLACESEL, #False, "")
EndIf
ProcedureReturn 0
EndProcedure
Procedure.i OnKeyDown(*this.S_STRINGGADGET, uMsg, wParam, lParam)
Protected lRes.i, sText.s, iStart.i, iEnd.i, iLen.i
If wParam = #VK_DELETE
;// If deleting make sure it's the last character or that
;// the selection goes all the way To the End of the text
GetSel(iStart, iEnd)
sText = GetGadgetText(*this\PB_ID)
iLen = Len(sText)
If iLen <> iEnd
If Not (iEnd = iStart And iEnd = iLen - 1)
ProcedureReturn 0
EndIf
EndIf
EndIf
lRes = CallWindowProc_(*this\OrgProc, *this\hWnd, uMsg, wParam, lParam)
ProcedureReturn lRes
EndProcedure
Procedure.i OnChar(*this.S_STRINGGADGET, uMsg, wParam, lParam)
Protected sText.s, iStart.i, iEnd.i, iMaskLen.i, c.c, iLen.i, cMask.c
Protected iSymbol.i,sSymbol.s, sMaskPortion.s, iMaskPos.i
If IsReadOnly(*this\PB_ID)
ProcedureReturn 0
EndIf
c = wParam
iMaskLen = Len(*this\sMask)
If (iMaskLen = 0) Or ListSize(lstSymbols()) = 0
ProcedureReturn CallWindowProc_(*this\OrgProc, *this\hWnd, uMsg, wParam, lParam)
EndIf
;// Check that we haven't gone past the mask's length
GetSel(iStart, iEnd)
If iStart >= iMaskLen And c <> #VK_BACK
ProcedureReturn 0
EndIf
sText = GetGadgetText(*this\PB_ID)
iLen = Len(sText)
;// Check For a non-printable character (such As Ctrl+C)
If Not (_istprint(c))
If (c = #VK_BACK And iStart <> iLen)
SendMessage_(*this\hWnd, #WM_KEYDOWN, #VK_LEFT, 0); // move the cursor left
ProcedureReturn 0
EndIf
;// Allow backspace only If the cursor is all the way To the right
ProcedureReturn CallWindowProc_(*this\OrgProc, *this\hWnd, uMsg, wParam, lParam)
EndIf
cMask = Asc(Mid(*this\sMask, iStart + 1, 1))
;// Check If the mask's character matches with any of the symbols in the array.
ForEach lstSymbols()
If lstSymbols()\cSymbol = cMask
If lstSymbols()\funcValidate(c)
If iEnd = iLen
iEnd = iEnd + 1
Else
iEnd = iStart + 1
EndIf
SetSel(iStart, iEnd)
If lstSymbols()\funcConvert
c = lstSymbols()\funcConvert(c)
EndIf
ReplaceSel(#True, Chr(c))
ProcedureReturn 0
EndIf
EndIf
Next
;// Check If it's the same character as the mask.
If (cMask = c )
If iEnd = iLen
iEnd = iEnd
Else
iEnd = iStart + 1
EndIf
SetSel(iStart, iEnd)
ReplaceSel(#True, Chr(c))
ProcedureReturn 0
EndIf
;// Concatenate all the mask symbols
sSymbol = ""
ForEach lstSymbols()
sSymbol = sSymbol + Chr(lstSymbols()\cSymbol)
Next
;// If it's a valid character, find the next symbol on the mask and add any non-mask characters in between.
ForEach lstSymbols()
;// See If the character is valid For any other symbols
If Not lstSymbols()\funcValidate(c)
Continue
EndIf
;// Find the position of the next symbol
sMaskPortion = Mid(*this\sMask, iStart + 1)
For j = 1 To Len(sMaskPortion)
If FindString(sSymbol, Mid(sMaskPortion,j,1))
iMaskPos = j
Break
EndIf
Next
;// Enter the character If there isn't another symbol before it
If (iMaskPos > 0 ) And Mid(sMaskPortion, iMaskPos, 1) = Chr(lstSymbols() \cSymbol)
SetSel(iStart, iStart + iMaskPos )
a$ = Left(sMaskPortion, iMaskPos - 1 )
ReplaceSel(#True, a$);
If lstSymbols()\funcConvert
wParam = lstSymbols()\funcConvert(wParam)
EndIf
CallWindowProc_(*this\OrgProc, *this\hWnd, uMsg, wParam, lParam)
ProcedureReturn 0
EndIf
Next
EndProcedure
;// Returns true if the control is read only
Procedure.b IsReadOnly(Gadget)
If GadgetType(Gadget) = #PB_GadgetType_String
ProcedureReturn Bool(GetWindowLongPtr_(GadgetID(Gadget), #GWL_STYLE) & #ES_READONLY)
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i GetGadgetAttributeEx(Gadget, Attribute)
Protected *this.S_STRINGGADGET
*this = GetProp_(GadgetID(Gadget), #EDITMASK_PROP)
If *this
Select Attribute
Case #EDITMASK
ProcedureReturn @*this\sMask
EndSelect
EndIf
ProcedureReturn 0
EndProcedure
Procedure CB(hWnd, uMsg, wParam, lParam)
Protected *this.S_STRINGGADGET
Protected lRes.i
*this = GetProp_(hWnd, #EDITMASK_PROP)
If Not *this
lRes = DefWindowProc_(hWnd, uMsg, wParam, lParam)
Else
Select uMsg
Case #WM_KEYDOWN
; // Handles the WM_KEYDOWN message, which is called when the user enters a special character such As Delete Or the arrow keys.
lRes = OnKeyDown(*this, uMsg, wParam, lParam)
Case #WM_CHAR
lRes = OnChar(*this, uMsg, wParam, lParam)
Case #WM_PASTE
lRes = OnPaste(*this, uMsg, wParam, lParam)
Case #WM_CUT
lRes = OnCut(*this, uMsg, wParam, lParam)
Case #WM_CLEAR
lRes = OnClear(*this, uMsg, wParam, lParam)
Case #WM_SETTEXT
lRes = OnSetText(*this, uMsg, wParam, lParam)
Case #WM_DESTROY
RemoveProp_(hWnd, #EDITMASK_PROP)
lRes = CallWindowProc_(*this\OrgProc, hWnd, uMsg, wParam, lParam)
ClearStructure(*this, S_STRINGGADGET)
FreeMemory(*this)
Default
lRes = CallWindowProc_(*this\OrgProc, hWnd, uMsg, wParam, lParam)
EndSelect
EndIf
ProcedureReturn lRes
EndProcedure
Procedure SetGadgetAttributeEx(Gadget, Attribute, Value)
Protected *this.S_STRINGGADGET
Select Attribute
Case #EDITMASK
If IsGadget(Gadget)
If GadgetType(Gadget) = #PB_GadgetType_String
*this = GetProp_(GadgetID(Gadget), #EDITMASK_PROP)
If *this
If *this\sMask <> PeekS(Value)
*this\sMask = PeekS(Value)
Redraw(*this)
EndIf
Else
*this = AllocateMemory(SizeOf(S_STRINGGADGET))
If *this
InitializeStructure(*this, S_STRINGGADGET)
*this\PB_ID = Gadget
*this\hWnd = GadgetID(Gadget)
*this\sMask = PeekS(Value)
SetWindowLongPtr_(GadgetID(Gadget), #GWL_STYLE, (GetWindowLongPtr_(GadgetID(Gadget), #GWL_STYLE) & ~#ES_LOWERCASE & ~#ES_NUMBER & ~#ES_UPPERCASE))
*this\OrgProc = GetWindowLongPtr_(*this\hWnd, #GWL_WNDPROC)
SetWindowLongPtr_(GadgetID(Gadget), #GWL_WNDPROC, @CB())
SetProp_(*this\hWnd, #EDITMASK_PROP, *this)
Redraw(*this)
EndIf
EndIf
EndIf
SendMessage_(*this\hWnd, #EM_SETCUEBANNER, #True, Value)
EndIf
EndSelect
EndProcedure
Procedure.b SetSymbol(Symbol.c, fValidate.funcValidateChar, fConvert.funcConvertChar = #Null)
Protected lRes.b = #False, lFound.b = #False
If fValidate
ForEach lstSymbols()
If lstSymbols()\cSymbol = Symbol
lstSymbols()\funcValidate = fValidate
If fConvert
lstSymbols()\funcConvert = fConvert
EndIf
lbFound = #True
Break
EndIf
Next
If Not lbFound
AddElement(lstSymbols())
lstSymbols()\cSymbol = Symbol
lstSymbols()\funcValidate = fValidate
If fConvert
lstSymbols()\funcConvert = fConvert
EndIf
EndIf
lRes = #True
EndIf
ProcedureReturn lRes
EndProcedure
EndModule
;- Example
CompilerIf #PB_Compiler_IsMainFile
;-Define functions to be used in the editmask
;-Validation functions
Procedure.b IsDigit(cValue.c)
ProcedureReturn Bool((cValue> 47 And cValue < 58 ) )
EndProcedure
Procedure.b IsAlfa(cValue.c)
ProcedureReturn Bool((cValue >= 65 And cValue <= 90) Or (cValue >= 97 And cValue <= 122))
EndProcedure
;- Convert functions
Procedure.c ToUpper(c.c)
ProcedureReturn Asc(UCase(Chr(c)))
EndProcedure
If OpenWindow(0, 0, 0, 322, 205, "StringGadget Editmask Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
StringGadget(1, 8, 35, 306, 20, ":")
StringGadget(2, 8, 60, 306, 20, "/")
UseModule LSMASK
;- Define symbols to be used in the mask
SetSymbol('A', @IsAlfa(), @ToUpper())
SetSymbol('#', @IsDigit())
;- Set editmask
SetGadgetAttributeEx(1, #EDITMASK, @"AA: ####")
SetGadgetAttributeEx(2, #EDITMASK, @"##/######")
mask = GetGadgetAttributeEx(1, #EDITMASK)
If mask
Debug "Editmask for Gadget1: " + PeekS(mask)
EndIf
UnuseModule LSMASK
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
CompilerEndIf
