Hello, FPC developers' list.
In lazarus I need one function which does not present in fpc but exists
in delphi rtl.
I prepared a patch which adds it to fpc rtl.
--
Best regards,
Paul Ishenin.
Index: maskutils.pp
===================================================================
--- maskutils.pp (revision 12457)
+++ maskutils.pp (working copy)
@@ -48,6 +48,7 @@
function FormatMaskText(const EditMask: string; const Value: string): string;
function FormatMaskInput(const EditMask: string): string;
+function MaskDoFormatText(const EditMask: string; const Value: string; Blank:
Char): string;
@@ -69,13 +70,13 @@
type
TMaskUtils = class(TObject)
- private
+ private
FValue: string;
SourcePosition,Position : Integer;
FEditMask,FMask : string;
SourceVal,ExitVal : string;
- Matched : Boolean;
- MissChar : Char;
+ FMatched : Boolean;
+ FMissChar : Char;
State : TParseState;
procedure EvaluateExit;
procedure EvaluateMissing;
@@ -96,12 +97,14 @@
function GetInputMask: string;
procedure SetMask(const AValue: string);
procedure SetValue(const AValue: string);
- protected
+ protected
procedure RaiseError;
procedure ExtractMask;
function MaskPtr : Char;
function SourcePtr : Char;
- public
+ property Matched: Boolean read FMatched write FMatched;
+ property MissChar: Char read FMissChar write FMissChar;
+ public
function ValidateInput : string;
property Mask : string read FEditMask write SetMask;
property Value : string read FValue write SetValue;
@@ -571,6 +574,26 @@
end;
end;
+{
+ Format Value string using EditMask, dont use 2d and 3d fields of EditMask,
+ set own Blank char and Matched = False
+}
+function MaskDoFormatText(const EditMask: string; const Value: string; Blank:
Char): string;
+var
+ msk : TMaskUtils;
+begin
+ Result := '';
+ msk := TMaskUtils.Create;
+ try
+ msk.Mask := EditMask;
+ msk.Value := Value;
+ msk.Matched := False;
+ msk.MissChar := Blank;
+ Result := msk.ValidateInput;
+ finally
+ msk.Free;
+ end;
+end;
end.
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
