* some new patches from Boguslaw

git-svn-id: trunk@9244 -

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,17 +45,9 @@ Classes
  {$endif};
 
 
-function FormatMaskText(const EditMask: string; const Value: string): string;
-
-implementation
-
-
-resourcestring
-
-//exInvalidMaskValue = 'Input mask value incorrect';
-exInvalidMaskValue = 'FormatMaskText function failed!';
-//replace above text when all bugs will be fixed!
 
+function FormatMaskText(const EditMask: string; const Value: string): string;
+function FormatMaskInput(const EditMask: string): string;
 
 
 
@@ -75,7 +60,7 @@ type
   stSpecial,  //use escape character
   stArbitrary //put arbitrary character
   );
-  
+
   TParseState = set of TStepState;
 
 
@@ -84,8 +69,8 @@ type
 
 type
   TMaskUtils = class(TObject)
-    FValue: string;
     private
+    FValue: string;
     SourcePosition,Position : Integer;
     FEditMask,FMask : string;
     SourceVal,ExitVal : string;
@@ -96,7 +81,9 @@ type
     procedure EvaluateMissing;
     procedure DoFillRest;
     procedure DoLiteral;
+    procedure DoLiteralInputMask;
     procedure DoToken;
+    procedure DoTokenInputMask;
     procedure DoUpper;
     procedure DoLower;
     procedure DoNumeric(Required : Boolean);
@@ -106,6 +93,7 @@ type
     procedure DoArbitrary(Required : Boolean);
     procedure DoTime;
     procedure DoDate;
+    function GetInputMask: string;
     procedure SetMask(const AValue: string);
     procedure SetValue(const AValue: string);
     protected
@@ -114,14 +102,32 @@ type
     function MaskPtr : Char;
     function SourcePtr : Char;
     public
-    function Validate : string;
+    function ValidateInput : string;
     property Mask : string read FEditMask write SetMask;
     property Value : string read FValue write SetValue;
+    property InputMask : string read GetInputMask;
   end;
 
 
 
 
+
+implementation
+
+
+resourcestring
+
+//exInvalidMaskValue = 'Input mask value incorrect';
+exInvalidMaskValue = 'FormatMaskText function failed!';
+//replace above text when all bugs will be fixed!
+
+
+
+
+
+
+
+
 function IsNumeric(const C : Char) : Boolean;
 begin
   Result := C In ['0'..'9'];
@@ -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;