diff --git a/packages/fcl-base/src/inc/maskutils.pp b/packages/fcl-base/src/inc/maskutils.pp index 241560eda6..207949631a 100644 --- a/packages/fcl-base/src/inc/maskutils.pp +++ b/packages/fcl-base/src/inc/maskutils.pp @@ -31,16 +31,9 @@ unit maskutils; {$mode objfpc}{$H+} {.$define DebugMaskUtils} -{.$define MaskRaiseException} -{ Define MaskRaiseException only if you want strict matching for required -characters. It raises exception for some tests valid under delphi like - -AssertEquals('(123)_ - ', FormatMaskText('(000)_000-0000;0;*','123')); - -} interface @@ -52,7 +45,72 @@ Classes {$endif}; + function FormatMaskText(const EditMask: string; const Value: string): string; +function FormatMaskInput(const EditMask: string): string; + + + +type + TStepState = + ( + stLeading, //? not used currently + stUpper, //use uppercase + stLower, //use lowercase + stSpecial, //use escape character + stArbitrary //put arbitrary character + ); + + TParseState = set of TStepState; + + + +{ TMaskUtils } + +type + TMaskUtils = class(TObject) + private + FValue: string; + SourcePosition,Position : Integer; + FEditMask,FMask : string; + SourceVal,ExitVal : string; + Matched : Boolean; + MissChar : Char; + State : TParseState; + procedure EvaluateExit; + procedure EvaluateMissing; + procedure DoFillRest; + procedure DoLiteral; + procedure DoLiteralInputMask; + procedure DoToken; + procedure DoTokenInputMask; + procedure DoUpper; + procedure DoLower; + procedure DoNumeric(Required : Boolean); + procedure DoAlpha(Required : Boolean); + procedure DoAlphaNumeric(Required : Boolean); + procedure DoNumericPlusMinus; + procedure DoArbitrary(Required : Boolean); + procedure DoTime; + procedure DoDate; + function GetInputMask: string; + procedure SetMask(const AValue: string); + procedure SetValue(const AValue: string); + protected + procedure RaiseError; + procedure ExtractMask; + function MaskPtr : Char; + function SourcePtr : Char; + public + function ValidateInput : string; + property Mask : string read FEditMask write SetMask; + property Value : string read FValue write SetValue; + property InputMask : string read GetInputMask; + end; + + + + implementation @@ -66,58 +124,6 @@ exInvalidMaskValue = 'FormatMaskText function failed!'; -type - TStepState = - ( - stLeading, //? not used currently - stUpper, //use uppercase - stLower, //use lowercase - stSpecial, //use escape character - stArbitrary //put arbitrary character - ); - - TParseState = set of TStepState; - - - -{ TMaskUtils } - -type - TMaskUtils = class(TObject) - FValue: string; - private - SourcePosition,Position : Integer; - FEditMask,FMask : string; - SourceVal,ExitVal : string; - Matched : Boolean; - MissChar : Char; - State : TParseState; - procedure EvaluateExit; - procedure EvaluateMissing; - procedure DoFillRest; - procedure DoLiteral; - procedure DoToken; - procedure DoUpper; - procedure DoLower; - procedure DoNumeric(Required : Boolean); - procedure DoAlpha(Required : Boolean); - procedure DoAlphaNumeric(Required : Boolean); - procedure DoNumericPlusMinus; - procedure DoArbitrary(Required : Boolean); - procedure DoTime; - procedure DoDate; - procedure SetMask(const AValue: string); - procedure SetValue(const AValue: string); - protected - procedure RaiseError; - procedure ExtractMask; - function MaskPtr : Char; - function SourcePtr : Char; - public - function Validate : string; - property Mask : string read FEditMask write SetMask; - property Value : string read FValue write SetValue; - end; @@ -165,7 +171,7 @@ end; -function TMaskUtils.Validate: string; +function TMaskUtils.ValidateInput : string; begin {Prepare} ExitVal := ''; @@ -203,12 +209,9 @@ end; procedure TMaskUtils.RaiseError;inline; begin if SourcePosition > Length(SourceVal) then - EvaluateMissing; -{$ifdef MaskRaiseException} - raise Exception.CreateFmtHelp(exInvalidMaskValue,[],Position); -{$endif} - if Matched then - raise Exception.CreateFmtHelp(exInvalidMaskValue,[],Position); + EvaluateMissing + else + raise Exception.CreateFmtHelp(exInvalidMaskValue,[],Position); end; @@ -231,6 +234,7 @@ end; + {Extract mask from input parameter} procedure TMaskUtils.ExtractMask; var @@ -246,8 +250,6 @@ begin else begin MissChar := PChar(Copy(s,P+1,1))^; - //for compatibility with delphi bug ,uncomment line below ! - //MissChar := #32; Delete(s,P,2); P := LastDelimiter(';',s); Matched := (Copy(s,P+1,1) <> '0'); @@ -394,6 +396,27 @@ begin ExitVal := ExitVal + DateSeparator; end; +function TMaskUtils.GetInputMask: string; +begin + {Prepare} + ExitVal := ''; + Position := 1; + State := []; + + {Process} + while (Position <= Length(FMask)) do + begin + if (IsToken(MaskPtr) and not (stSpecial In State)) then + DoTokenInputMask + else + DoLiteralInputMask; + + Inc(Position); + end; + + Result := ExitVal; +end; + @@ -444,6 +467,32 @@ begin end; + + +procedure TMaskUtils.DoTokenInputMask; +begin + + case MaskPtr of + '!', + '>', + '<' : ;{nothing} + '\' : Include(State,stSpecial); + 'L', + 'l', + 'A', + 'a', + 'C', + 'c', + '0', + '9', + '#' : ExitVal := ExitVal + MissChar; + ':' : DoTime; + '/' : DoDate; + end; + +end; + + procedure TMaskUtils.DoLiteral; begin {$ifdef DebugMaskUtils} @@ -458,6 +507,16 @@ begin ExitVal := ExitVal + MaskPtr; end; + +procedure TMaskUtils.DoLiteralInputMask; +begin + if stSpecial in State then + Exclude(State,stSpecial); + ExitVal := ExitVal + MaskPtr; +end; + + + procedure TMaskUtils.DoFillRest; var i : Integer; @@ -479,6 +538,8 @@ Compatibility with delphi} end; + + function FormatMaskText(const EditMask: string; const Value: string): string; var msk : TMaskUtils; @@ -488,7 +549,23 @@ begin try msk.Mask := EditMask; msk.Value := Value; - Result := msk.Validate; + Result := msk.ValidateInput; + finally + msk.Free; + end; +end; + +{Returns preprocessed mask (without escape characters, with currect locale date +and time separators) } +function FormatMaskInput(const EditMask: string): string; +var + msk : TMaskUtils; +begin + Result := ''; + msk := TMaskUtils.Create; + try + msk.Mask := EditMask; + Result := msk.InputMask; finally msk.Free; end;