{
 /***************************************************************************
                                 maskedit.pp
                                 -----------
                           Component Library Code

 ***************************************************************************/

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}


{
ToDo List:
 - Better handling of cut/clear/paste messages

Bugs:
 - The Delphi helpt text says that a '_' in EditMask will insert a blank in the text.
   However all versions of Delphi up to D2010 treat it as a literal '_' (unless
   specified in the 3rd field of a multifield EditMask), so I rewrote parts to make it behave like
   that also.
   If, in the future, Delphi actually treats '_' as a blank, we'll re-implement it, for that
   purpose I did not remove the concerning code, but commented it out

Known Utf8 related issues: (Oktober 2012, BB)
 - Utf8 also has what is called de-composed code-points:
   For example the "LATIN SMALL LETTER E WITH DIAERESIS" can be represented with a single codepoint
   (U+00EB), but also by the sequence of codepoints  LATIN SMALL LETTER E (U+0065) +  COMBINING DIAERESIS (U+0308)
   The latter form is not handled correctly ATM, but also does not occur much "in the wild"
   (See discussion at the forum: http://forum.lazarus.freepascal.org/index.php/topic,10530.0.html)
 - Some valid Utf8 sequences do not represent any visible character.
   I have not been able to test how this affects the maskedit unit.


Different behaviour than Delphi, but by design (October 2009, BB)
 - In SetText in Delphi, when MaskNoSave is in EditMask, it is possible to set text longer then the mask
   allowes for. I disallowed that, because it corrupts internal cursor placement etc.
 - SetEditText is not Delphi compatible. Delphi allows setting any text in the control, leaving the control
   in an unrecoverable state, where it is impossible to leave the control because the text can never be validated
   (too short, too long, overwritten maskliterals). The app wil crash as a result of this.
   I have decided to disallow this:
   - EditText is truncated, or padded with ClearChar if necessary so that Utf8Length(EditText) = FMaskLength
   - Restore all MaskLiterals in the text
}

unit MaskEdit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls, LMessages, Clipbrd, LCLType, LCLProc, LCLStrConsts, LazUtf8;

const
  { Mask Type
    When adding more: make sure to add them to Simple_cMask_Tokens if appropriate
  }
  cMask_SpecialChar   = '\'; // after this you can set an arbitrary char
  cMask_UpperCase     = '>'; // after this the chars is in upper case
  cMask_LowerCase     = '<'; // after this the chars is in lower case
  cMask_Letter        = 'l'; // only a letter but not necessary
  cMask_LetterFixed   = 'L'; // only a letter
  cMask_AlphaNum      = 'a'; // an alphanumeric char (['A'..'Z','a..'z','0'..'9']) but not necessary
  cMask_AlphaNumFixed = 'A'; // an alphanumeric char
  cMask_AllChars      = 'c'; // any Utf8 char but not necessary
  cMask_AllCharsFixed = 'C'; // any Utf8 but NOT FSpaceChar
  cMask_Number        = '9'; // only a number but not necessary
  cMask_NumberFixed   = '0'; // only a number
  cMask_NumberPlusMin = '#'; // only a number or + or -, but not necessary
  cMask_HourSeparator = ':'; // automatically put the hour separator char
  cMask_DateSeparator = '/'; // automatically but the date separator char
  cMask_Hex           = 'h'; // a hexadecimal character (['0'..'9','a'..'f']) but not necessary  (Lazarus extension, not supported by Delphi)
  cMask_HexFixed      = 'H'; // a hexadecimal character                                          (Lazarus extension, not supported by Delphi)
  cMask_Binary        = 'b'; // a binary character (['0'..'1']) but not necessary (Lazarus extension, not supported by Delphi)
  cMask_BinaryFixed   = 'B'; // a binary character                                (Lazarus extension, not supported by Delphi)
  cMask_NoLeadingBlanks = '!'; //Trim leading blanks, otherwise trim trailing blanks from the data
  cMask_SetStart      = '[';   // [abc] is ['a','b','c']. [a-z] = ['a'..'z']. Sets are case-sensitive always ATM. Sets can only contain ASCII.
  cMask_SetEnd        = ']';
  cMask_SetNegate     = '!';   //[!abc] means: must not be in ['a','b','c'].
  cMask_SetOptional   = '|';   //[|abc] means: must be in 'a','b','c' or blank, only interpreted as such if set is not negated with cMask_SetNegate
  cMask_SetRange      = '-';

  {Delphi compatibility: user can change these at runtime}
  DefaultBlank: Char = '_';
  MaskFieldSeparator: Char = ';';
  MaskNoSave: Char = '0';

type
  { Type for mask (internal)
   When adding more: make sure to add them in procedure InitcMaskToMaskedTypeArray if appropriate
  }
  tMaskedType = (Char_Invalid,
                 Char_IsLiteral,
                 Char_Number,
                 Char_NumberFixed,
                 Char_NumberPlusMin,
                 Char_Letter,
                 Char_LetterFixed,
                 Char_LetterUpCase,
                 Char_LetterDownCase,
                 Char_LetterFixedUpCase,
                 Char_LetterFixedDownCase,
                 Char_AlphaNum,
                 Char_AlphaNumFixed,
                 Char_AlphaNumUpCase,
                 Char_AlphaNumDownCase,
                 Char_AlphaNumFixedUpCase,
                 Char_AlphaNumFixedDownCase,
                 Char_All,
                 Char_AllFixed,
                 Char_AllUpCase,
                 Char_AllDownCase,
                 Char_AllFixedUpCase,
                 Char_AllFixedDownCase,
                {Char_Space,                 //not Delphi compatible, see notes above  }
                 Char_HourSeparator,
                 Char_DateSeparator,
                 Char_Hex,                   //Lazarus extension, not supported by Delphi
                 Char_HexFixed,              //Lazarus extension, not supported by Delphi
                 Char_HexUpCase,             //Lazarus extension, not supported by Delphi
                 Char_HexDownCase,           //Lazarus extension, not supported by Delphi
                 Char_HexFixedUpCase,        //Lazarus extension, not supported by Delphi
                 Char_HexFixedDownCase,      //Lazarus extension, not supported by Delphi
                 Char_Binary,                //Lazarus extension, not supported by Delphi
                 Char_BinaryFixed,           //Lazarus extension, not supported by Delphi
                 Char_Set,                   //Lazarus extension, not supported by Delphi
                 Char_SetFixed ,             //Lazarus extension, not supported by Delphi
                 Char_SetNegateFixed         //Lazarus extension, not supported by Delphi
                 );

  TIntMaskRec = record
    MaskType: TMaskedType;
    Literal: TUtf8Char;
    CharSet: TSysCharSet;
  end;

  TInternalMask = array[1..255] of TIntMaskRec;
  TMaskeditTrimType = (metTrimLeft, metTrimRight);
  TMaskEditValidationErrorMode = (mvemException, mvemEvent);

  { Exception class }
type
  EDBEditError = class(Exception);
  EInvalidEditMask = class(EDBEditError);
  //Utf8 handling errors
  EInvalidUtf8 = class(Exception);
  EInvalidCodePoint = class(EInvalidUtf8);

const
  SInvalidCodePoint = 'The (hexadecimal) sequence %s is not a valid UTF8 codepoint.';
  SIndexOutOfRangeForFMask = 'MaskEdit Internal Error'^m'Range check error trying to access FMask[%d]. Index should be between 1 and %d';
  SFoundChar_Invalid = 'MaskEdit Internal Error.'^m' Found uninitialized MaskType "Char_Invalid" at index %d';
  SUnclosedSet = 'Illegal value for EditMask: set is not closed.';
  SIllegalCharInSet = 'Illegal value in EditMask: sets can only contain ASCII characters.';
  SEmptySet = 'Illegal value for EditMask: a set can not be empty.';
  SIllegalRangeChar = 'Illegal value for EditMask: you can not have two consecutive "'+cMask_SetRange+'"''s in a set';

{ ***********************************************************************************************

 Please leave in this note until it no longer applies!

 FOR ANYONE WHO CARES TO FIX/ENHANCE THIS CODE:

 Since we want total control over anything that is done to the text in the control
 we have to take into consideration the fact that currently we cannot prevent
 cutting/pasting/clearing or dragging selected text in the control, these are handled by the OS
 and text is changed before we can prevent it.
 Not all widgetsets currently handle the messages for cut/paste/clear. Actually we would
 like to have a LM_BEFORE_PASTE (etc.) message...
 If we allow the OS to cut/clear/paste etc. a situation can occur where mask-literals in the
 control are changed with random chars (and cannot be undone) or text is shorter or larger than
 the editmask calls for, which again cannot be undone.


 So, as a horrible hack I decided  to only allow changing of the text if we coded
 this change ourself. This is done by setting the FChangeAllowed field to True before any
 write action (in RealSetTextWhileMasked() ).
 We try to intercept the messages for cut/paste/copy/clear and perform the appropriate
 actions instead.
 If this fails, then in TextChanged we check and will see that FChangeAllowed = False
 and we will undo the changes made.

 To make this undo possible it is necessary to set FCurrentText every time you set
 the text in the control!
 This is achieved in RealSetTextWhileMasked() only, so please note:
 !! It is unsafe to make a call to RealSetText unless done so via RealSetTextWhileMasked() !!!

 (Bart Broersma, januari 2009)

 ************************************************************************************************ }


 { TCustomMaskEdit }

 Type

  TCustomMaskEdit = Class(TCustomEdit)
  private
    FRealEditMask    : String;            // Real EditMask inserted
    FMask            : TInternalMask;     // Actual internal mask
    FMaskLength      : Integer;           // Length of internal mask
    FFirstFreePos    : Integer;           // First position where user can enter text (it is 1-based)
    FMaskSave        : Boolean;           // Save mask as part of the data
    FTrimType        : TMaskEditTrimType; // Trim leading or trailing spaces in GetText
    FSpaceChar       : Char;              // Char for space (default '_')
    FCurrentText     : TCaption;          // FCurrentText is our backup. See notes above!
    FTextOnEnter     : String;            // Text when user enters the control, used for Reset()
    FCharPos         : Integer;           // Current character position (1-based)
    FChangeAllowed   : Boolean;           // We do not allow text changes by the OS (cut/clear via context menu)
    FInitialText     : String;            // Text set in the formdesigner (must be handled in Loaded)
    FInitialMask     : String;            // EditMask set in the formdesigner (must be handled in Loaded)
    FSettingInitialText: Boolean;
    FValidationFailed: Boolean;           // Flag used in DoEnter
    FMaskIsPushed    : Boolean;
    FSavedMask       : TInternalMask;
    FSavedMaskLength : Integer;
    FTextChangedBySetText: Boolean;
    FInRealSetTextWhileMasked: Boolean;
    FEnableSets:     Boolean;

    FValidationErrorMode: TMaskEditValidationErrorMode;
    FOnValidationError: TNotifyEvent;

    procedure ClearInternalMask(out AMask: TInternalMask; out ALengthIndicator: Integer);
    procedure AddToMask(ALiteral: TUtf8Char);
    procedure AddToMask(AMaskType: TMaskedType; ACharSet: TSysCharSet = []);
    function GetModified: Boolean;
    function GetMask(Index: Integer): TIntMaskRec; //use this to read FMask values
    procedure SetEditMask(const Value : String);
    procedure ParseSet(const S: String; var i: integer; SUlen: PtrInt; out ACharSet: TSysCharSet; out IsNegative, IsOptional: Boolean);
    function  GetIsMasked : Boolean;
    procedure SetModified(AValue: Boolean);
    procedure SetSpaceChar(Value : Char);

    procedure SetCursorPos;
    procedure SelectNextChar;
    procedure SelectPrevChar;
    procedure SelectFirstChar;
    procedure GotoEnd;
    procedure JumpToNextDot(Dot: Char);
    function  HasSelection: Boolean;
    function  HasExtSelection: Boolean;

    Function  IsLiteral(Index: Integer): Boolean;
    function  TextIsValid(const Value: String): Boolean;
    function  CharMatchesMask(const Ch: TUtf8Char; const Position: Integer): Boolean;
    function  ClearChar(Position : Integer) : TUtf8Char;

    procedure RealSetTextWhileMasked(const Value: TCaption); //See notes above!
    procedure InsertChar(Ch : TUtf8Char);
    Function  CanInsertChar(Position : Integer; Var Ch : TUtf8Char; IsPasting: Boolean = False) : Boolean;
    procedure DeleteSelected;
    procedure DeleteChars(NextChar : Boolean);
  protected
    class procedure WSRegisterClass; override;
    function ApplyMaskToText(Value: TCaption): TCaption;
    function CanShowEmulatedTextHint: Boolean; override;
    function DisableMask(const NewText: String): Boolean;
    procedure DoValidationError;
    function RestoreMask(const NewText: String): Boolean;
    procedure RealSetText(const AValue: TCaption); override;
    function RealGetText: TCaption; override;
    Function GetTextWithoutMask(Value: TCaption) : TCaption;
    function GetTextWithoutSpaceChar(Value: TCaption) : TCaption;
    Procedure SetTextApplyMask(Value: TCaption);
    function  GetEditText: string; virtual;
    procedure SetEditText(const AValue: string);

    procedure GetSel(out _SelStart: Integer; out _SelStop: Integer);
    procedure SetSel(const _SelStart: Integer; _SelStop: Integer);
    procedure TextChanged; override;
    procedure Change; override;
    procedure SetCharCase(Value: TEditCharCase); override;
    procedure SetMaxLength(Value: Integer);
    function GetMaxLength: Integer;
    procedure SetNumbersOnly(Value: Boolean); override;
    procedure Loaded; override;

    procedure LMPasteFromClip(var Message: TLMessage); message LM_PASTE;
    procedure LMCutToClip(var Message: TLMessage); message LM_CUT;
    procedure LMClearSel(var Message: TLMessage); message LM_CLEAR;

    function  EditCanModify: Boolean; virtual;
    procedure Reset; virtual;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure HandleKeyPress(var Key: TUtf8Char);
    procedure KeyPress(var Key: Char); override;
    procedure Utf8KeyPress(var UTF8Key: TUTF8Char); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    procedure CheckCursor;
    property EditText: string read GetEditText write SetEditText;
    property IsMasked: Boolean read GetIsMasked;
    property SpaceChar: Char read FSpaceChar write SetSpaceChar;
    property MaxLength: Integer read GetMaxLength write SetMaxLength;
    property EditMask: string read FRealEditMask write SetEditMask;
    property ValidationErrorMode: TMaskEditValidationErrorMode read FValidationErrorMode write FValidationErrorMode default mvemException; experimental;
  public
    procedure CutToClipBoard; override;
    procedure PasteFromClipBoard; override;
    { Required methods }
    constructor Create(TheOwner : TComponent); override;
    procedure Clear;
    procedure SelectAll; override;
    procedure ValidateEdit; virtual;

    property EnableSets: Boolean read FEnableSets write FEnableSets; experimental;
    property Modified: Boolean read GetModified write SetModified;

    property OnValidationError: TNotifyEvent read FOnValidationError write FOnValidationError; experimental;
  end;

  { TMaskEdit }

  TMaskEdit = class(TCustomMaskEdit)
  public
    property IsMasked;
    property EditText;
    property ValidationErrorMode;
  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BiDiMode;
    property BorderSpacing;
    property BorderStyle;
    property CharCase;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditingDone;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDock;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property EditMask;
    property Text;
    property TextHint;
    property SpaceChar;
  end;

function FormatMaskText(const AEditMask: string; const Value: string ): string;
procedure SplitEditMask(AEditMask: String; out AMaskPart: String; out AMaskSave: Boolean; out ASpaceChar: Char);

procedure Register;

implementation


//Define this to prevent validation when the control looses focus
{ $DEFINE MASKEDIT_NOVALIDATEONEXIT}


const
  //cMask constants that define a TMaskedType, with the exclusion of Set related cMask constants
  Simple_cMask_Tokens: TSysCharSet = [
    cMask_Letter,
    cMask_LetterFixed,
    cMask_AlphaNum,
    cMask_AlphaNumFixed,
    cMask_AllChars,
    cMask_AllCharsFixed,
    cMask_Number,
    cMask_NumberFixed,
    cMask_NumberPlusMin,
    cMask_HourSeparator,
    cMask_DateSeparator,
    cMask_Hex,
    cMask_HexFixed,
    cMask_Binary,
    cMask_BinaryFixed
  ];

type
  TMaskedTypeCase = (tmcNormal, tmcUp, tmcDown);
  TcMaskToMaskedTypeTable = Array[#33..'z', TMaskedTypeCase] of TMaskedType;

var
  cMaskToMaskedTypeTable: TcMaskToMaskedTypeTable;

function UpDownToMaskedTypeCase(InUp, InDown: Boolean): TMaskedTypeCase;
begin
  Result := tmcNormal;
  if InUp then Result := tmcUp
  else if InDown then Result := tmcDown;
end;

procedure InitcMaskToMaskedTypeTable;
begin
  cMaskToMaskedTypeTable := Default(TcMaskToMaskedTypeTable);

  cMaskToMaskedTypeTable[cMask_Letter, tmcNormal] := Char_Letter;
  cMaskToMaskedTypeTable[cMask_Letter, tmcUp] := Char_LetterUpCase;
  cMaskToMaskedTypeTable[cMask_Letter, tmcDown] := Char_LetterDownCase;

  cMaskToMaskedTypeTable[cMask_LetterFixed, tmcNormal] := Char_LetterFixed;
  cMaskToMaskedTypeTable[cMask_LetterFixed, tmcUp] := Char_LetterFixedUpCase;
  cMaskToMaskedTypeTable[cMask_LetterFixed, tmcDown] := Char_LetterFixedDownCase;

  cMaskToMaskedTypeTable[cMask_AlphaNum, tmcNormal] := Char_AlphaNum;
  cMaskToMaskedTypeTable[cMask_AlphaNum, tmcUp] := Char_AlphaNumUpCase;
  cMaskToMaskedTypeTable[cMask_AlphaNum, tmcDown] := Char_AlphaNumDownCase;

  cMaskToMaskedTypeTable[cMask_AlphaNumFixed, tmcNormal] := Char_AlphaNumFixed;
  cMaskToMaskedTypeTable[cMask_AlphaNumFixed, tmcUp] := Char_AlphaNumFixedUpCase;
  cMaskToMaskedTypeTable[cMask_AlphaNumFixed, tmcDown] := Char_AlphaNumFixedDownCase;

  cMaskToMaskedTypeTable[cMask_AllChars, tmcNormal] := Char_All;
  cMaskToMaskedTypeTable[cMask_AllChars, tmcUp] := Char_AllUpCase;
  cMaskToMaskedTypeTable[cMask_AllChars, tmcDown] := Char_AllDownCase;

  cMaskToMaskedTypeTable[cMask_AllCharsFixed, tmcNormal] := Char_AllFixed;
  cMaskToMaskedTypeTable[cMask_AllCharsFixed, tmcUp] := Char_AllFixedUpCase;
  cMaskToMaskedTypeTable[cMask_AllCharsFixed, tmcDown] := Char_AllFixedDownCase;

  cMaskToMaskedTypeTable[cMask_Number, tmcNormal] := Char_Number;
  cMaskToMaskedTypeTable[cMask_Number, tmcUp] := Char_Number;
  cMaskToMaskedTypeTable[cMask_Number, tmcDown] := Char_Number;

  cMaskToMaskedTypeTable[cMask_NumberFixed, tmcNormal] := Char_NumberFixed;
  cMaskToMaskedTypeTable[cMask_NumberFixed, tmcUp] := Char_NumberFixed;
  cMaskToMaskedTypeTable[cMask_NumberFixed, tmcDown] := Char_NumberFixed;

  cMaskToMaskedTypeTable[cMask_NumberPlusMin, tmcNormal] := Char_NumberPlusMin;
  cMaskToMaskedTypeTable[cMask_NumberPlusMin, tmcUp] := Char_NumberPlusMin;
  cMaskToMaskedTypeTable[cMask_NumberPlusMin, tmcDown] := Char_NumberPlusMin;

  cMaskToMaskedTypeTable[cMask_HourSeparator, tmcNormal] := Char_HourSeparator;
  cMaskToMaskedTypeTable[cMask_HourSeparator, tmcUp] := Char_HourSeparator;
  cMaskToMaskedTypeTable[cMask_HourSeparator, tmcDown] := Char_HourSeparator;

  cMaskToMaskedTypeTable[cMask_DateSeparator, tmcNormal] := Char_DateSeparator;
  cMaskToMaskedTypeTable[cMask_DateSeparator, tmcUp] := Char_DateSeparator;
  cMaskToMaskedTypeTable[cMask_DateSeparator, tmcDown] := Char_DateSeparator;

  cMaskToMaskedTypeTable[cMask_Hex, tmcNormal] := Char_Hex;
  cMaskToMaskedTypeTable[cMask_Hex, tmcUp] := Char_HexUpCase;
  cMaskToMaskedTypeTable[cMask_Hex, tmcDown] := Char_HexDownCase;

  cMaskToMaskedTypeTable[cMask_HexFixed, tmcNormal] := Char_HexFixed;
  cMaskToMaskedTypeTable[cMask_HexFixed, tmcUp] := Char_HexFixedUpCase;
  cMaskToMaskedTypeTable[cMask_HexFixed, tmcDown] := Char_HexFixedDownCase;

  cMaskToMaskedTypeTable[cMask_Binary, tmcNormal] := Char_Binary;
  cMaskToMaskedTypeTable[cMask_Binary, tmcUp] := Char_Binary;
  cMaskToMaskedTypeTable[cMask_Binary, tmcDown] := Char_Binary;

  cMaskToMaskedTypeTable[cMask_BinaryFixed, tmcNormal] := Char_BinaryFixed;
  cMaskToMaskedTypeTable[cMask_BinaryFixed, tmcUp] := Char_BinaryFixed;
  cMaskToMaskedTypeTable[cMask_BinaryFixed, tmcDown] := Char_BinaryFixed;

end;


function DbgS(AMaskType: TMaskedType): String; overload;
begin
  WriteStr(Result, AMaskType);
end;

function DbgS(ASet: TSysCharSet): String; overload;
var
  C: Char;
begin
  Result := '[';
  for C in ASet do
    Result := Result + C + ',';
  if (Result <> '[') then
    System.Delete(Result, Length(Result), 1);
  Result := Result + ']';
end;

function DbgS(AMask: TInternalMask): String; overload;
var
  El: TIntMaskRec;
  i: Integer;
begin
  Result := '';
  for i :=  1 to 255 do
  begin
    El := AMask[i];
    if (El.MaskType = Char_InValid) then
      Break;
    Result := Result + format('%3d: ',[i]);
    Result := Result + DbgS(El.MaskType);
    if (El.MaskType = Char_IsLiteral) then
      Result := Result + ', "' + El.Literal + '"';
    if (El.CharSet <> []) then
      Result := Result + ', ' + DbgS(El.CharSet);
    Result := Result + LineEnding;
  end;
end;

const
  Period = '.';
  Comma = ',';

//Utf8 helper functions
function StringToHex(S: String): String;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to length(S) do Result := Result + '$' + IntToHex(Ord(S[i]),2);
end;

function GetCodePoint(const S: String; const Index: PtrInt): TUTF8Char;
//equivalent for Result := S[Index], but for Utf8 encoded strings
var
  p: PChar;
  PLen: PtrInt;
  Res: AnsiString; //intermediate needed for PChar -> String -> ShortString assignement
begin
  Result := '';
  p := UTF8CodepointStart(PChar(S), Length(S), Index - 1); //zero-based call
  //determine the length in bytes of this UTF-8 character
  PLen := UTF8CodepointSize(p);
  Res := p;
  //Set correct length for Result (otherwise it returns all chars up to the end of the original string)
  SetLength(Res,PLen);
  Result := Res;
end;


procedure SetCodePoint(var S: String; const Index: PtrInt; CodePoint: TUTF8Char);
//equivalent for S[Index] := CodePoint, but for Utf8 encoded strings
var
  OldCP: TUTF8Char;
begin
  if (Index > Utf8Length(S)) then Exit;
  if (Utf8Length(CodePoint) <> 1) then Raise EInvalidCodePoint.Create(Format(SInvalidCodepoint,[StringToHex(CodePoint)]));
  OldCP := GetCodePoint(S, Index);
  if (OldCP = CodePoint) then Exit;
  Utf8Delete(S, Index, 1);
  Utf8Insert(CodePoint, S, Index);
end;



function FormatMaskText(const AEditMask: string; const Value: string): string;
var
  CME: TCustomMaskEdit;
begin
  CME := TCustomMaskEdit.Create(nil);
  try
    CME.EditMask := AEditMask;
    if CME.IsMasked then
    begin
      Result := CME.ApplyMaskToText(Value);
      //Delphi 7 leaves in the mask regardless of the "MaskSave" value in the specified EditMaske
      //but SpaceChar must be replaced by #32
      Result := CME.GetTextWithoutSpaceChar(Result);
    end
    else
      Result := Value;
  finally
    CME.Free;
  end;
end;

procedure SplitEditMask(AEditMask: String; out AMaskPart: String; out AMaskSave: Boolean; out ASpaceChar: Char);
{
  Retrieve the separate fields for a given EditMask:
  Given an AEditMask of '999.999;0;_'  it will return
  - AMaskPart = '999.999'
  - AMaskSave = False
  - ASpaceChar = '_'
}
begin
  {
    First see if AEditMask is multifield and if we can extract a value for
    AMaskSave and/or ASpaceChar
    If so, extract and remove from AMask (so we know that the remaining part of
    AMask _IS_ the mask to be set)

    A value for SpaceChar is only valid if also a value for MaskSave is specified
    (as by Delphi specifications), so Mask must be at least 4 characters
    These must be the last 2 or 4 characters of EditMask (and there must not be
    an escape character in front!)
  }
  //Assume no SpaceChar and no MaskSave is defined in new mask, so first set it to DefaultBlank and True
  ASpaceChar := DefaultBlank;
  AMaskSave := True;
  //MaskFieldseparator, MaskNoSave, SpaceChar and cMask_SpecialChar are defined as Char (=AnsiChar)
  //so in this case we can use Length (instead of Utf8length) and iterate single chars in the string
  if (Length(AEditMask) >= 4) and (AEditMask[Length(AEditMask)-1] = MaskFieldSeparator) and
     (AEditMask[Length(AEditMask)-3] = MaskFieldSeparator) and
     (AEditMask[Length(AEditMask)-2] <> cMask_SpecialChar) and
     //Length = 4 is OK (AEditMask = ";1;_" for example), but if Length > 4 there must be no escape charater in front
     ((Length(AEditMask) = 4) or ((Length(AEditMask) > 4) and (AEditMask[Length(AEditMask)-4] <> cMask_SpecialChar))) then
  begin
    ASpaceChar := AEditMask[Length(AEditMask)];
    AMaskSave := (AEditMask[Length(AEditMask)-2] <> MaskNosave);
    System.Delete(AEditMask,Length(AEditMask)-3,4);
  end
  //If not both FMaskSave and FSPaceChar are specified, then see if only FMaskSave is specified
  else if (Length(AEditMask) >= 2) and (AEditMask[Length(AEditMask)-1] = MaskFieldSeparator) and
          //Length = 2 is OK, but if Length > 2 there must be no escape charater in front
          ((Length(AEditMask) = 2) or ((Length(AEditMask) > 2) and (AEditMask[Length(AEditMask)-2] <> cMask_SpecialChar))) then
  begin
    AMaskSave := (AEditMask[Length(AEditMask)] <> MaskNoSave);
    //Remove this bit from Mask
    System.Delete(AEditMask,Length(AEditMask)-1,2);
  end;
  //Whatever is left of AEditMask at this point is the MaskPart
  AMaskPart := AEditMask;
end;


// Create object
constructor TCustomMaskEdit.Create(TheOwner: TComponent);
begin
  FSettingInitialText := False;
  FTextChangedBySetText := False;
  FInRealSetTextWhileMasked := False;
  FRealEditMask      := '';
  ClearInternalMask(FMask, FMaskLength);
  ClearInternalMask(FSavedMask, FSavedMaskLength);
  FSpaceChar     := '_';
  FMaskSave      := True;
  FChangeAllowed := False;
  FTrimType      := metTrimRight;
  Inherited Create(TheOwner);
  FCurrentText   := Inherited RealGetText;
  FTextOnEnter   := Inherited RealGetText;
  FInitialText   := '';
  FInitialMask   := '';
  FValidationFailed := False;
  FMaskIsPushed := False;
  FValidationErrorMode := mvemException;
  FEnableSets := False;
end;

procedure TCustomMaskEdit.ClearInternalMask(out AMask: TInternalMask; out ALengthIndicator: Integer);
begin
  AMask := Default(TInternalMask);
  ALengthIndicator := 0;
end;


procedure TCustomMaskEdit.AddToMask(ALiteral: TUtf8Char);
begin
  Inc(FMaskLength);
  FMask[FMaskLength].Literal := ALiteral;
  FMask[FMaskLength].MaskType := Char_IsLiteral;
end;

procedure TCustomMaskEdit.AddToMask(AMaskType: TMaskedType; ACharSet: TSysCharSet);
begin
  Inc(FMaskLength);
  FMask[FMaskLength].Literal := EmptyStr;
  FMask[FMaskLength].MaskType := AMaskType;
  FMask[FMaskLength].CharSet := ACharSet;
end;

function TCustomMaskEdit.GetModified: Boolean;
begin
  //This will make Modified = False inside OnChange when text is set by code
  //TCustomEdit.RealSetText sets Modified to False.
  //We handle all input in RealSetTextWhileMasked (which eventually calls RealSetText),
  //so inside RealSetTextWhileMasked Modified must be True,
  //unless we called RealSetTextWhileMasked from SetTextApplyMask, in that case it must be False,
  //in all other cases just return inherited value
  if FTextChangedBySetText then
    Result := False
  else
  begin
    if FInRealSetTextWhileMasked then
      Result := True
    else
      Result := inherited Modified;
  end;
end;

//Do sanity checks when reading FMask
function TCustomMaskEdit.GetMask(Index: Integer): TIntMaskRec;
begin
  Result := FMask[Index];
  if (Result.MaskType = Char_Invalid) then
  begin
    if (Index < 1) or (Index > FMaskLength) then
      raise ERangeError.CreateFmt(SIndexOutOfRangeForFMask,[Index, FMaskLength])
    else
      raise EDBEditError.CreateFmt(SFoundChar_Invalid,[Index]);
  end;
end;

// Prepare the real internal Mask
procedure TCustomMaskEdit.SetEditMask(const Value : String);
Var
  S: String;
  i: Integer;
  InUp, InDown, Special, IsNegative, IsOptional: Boolean;
  CP: TUtf8Char;
  SULen: PtrInt;
  CharSet: TSysCharSet;
  AMaskedTypeCase: TMaskedTypeCase;
  AMaskedType: tMaskedType;

  procedure UndoMask;
  begin
    ClearInternalMask(FMask, FMaskLength);
    MaxLength := 0;
    Clear;
  end;


begin
  //Setting Mask while loading has unexpected and unwanted side-effects
  if (csLoading in ComponentState) then
  begin
    FInitialMask := Value;
    Exit;
  end;
  if FRealEditMask <> Value then
  begin
    FRealEditMask := Value;
    FValidationFailed := False;
    FMaskIsPushed := False;
    ClearInternalMask(FMask, FMaskLength);
    ClearInternalMask(FSavedMask, FSavedMaskLength);

    SplitEditMask(FRealEditMask, S {Value}, FMaskSave, FSpaceChar);

    // Construct Actual Internal Mask
    // init
    FTrimType := metTrimRight;
    // Init: No UpCase, No LowerCase, No Special Char
    InUp      := False;
    InDown    := False;
    Special   := False;
    SULen := Utf8Length(S);
    i := 1;
    while (i <= SULen) do
    begin
      CP := GetCodePoint(S,i);
      // Must insert a special char
      if Special then
      begin
        AddToMask(CP);
        Special := False;
      end
      else
      begin //not Special
        // Check the char to insert
        case CP Of
          cMask_SpecialChar: Special := True;
          cMask_NoLeadingBlanks: FTrimType := metTrimLeft;

          cMask_UpperCase:
          begin
           if (i > 1) and (GetCodePoint(S,i-1) = cMask_LowerCase) then
           begin// encountered <>, so no case checking after this
             InUp := False;
             InDown := False
           end else
           begin
             InUp    := True;
             InDown := False;
           end;
          end;

          cMask_LowerCase:
          begin
           InDown  := True;
           InUp := False;
           // <> is catched by next cMask_Uppercase
          end;

          cMask_SetStart:
          begin
           if FEnableSets then
           begin
             //debugln('TCustomMaskEdit: start of set');
             try
               ParseSet(S, i, SULen, CharSet, IsNegative, IsOptional);
               if IsNegative then
               begin
                 //IsOptional makes no sense for a negative charset
                 AddToMask(Char_SetNegateFixed, CharSet);
               end
               else
               begin
                if IsOptional then
                  AddToMask(Char_Set, CharSet)
                 else
                   AddToMask(Char_SetFixed, CharSet);
               end;
               //debugln(['Added CharSet: ',Dbgs(CharSet),', IsNegative=',IsNegative,', IsOptional=',IsOptional]);

             except
               on E: EInvalidEditMask do
               begin
                 UndoMask;
                 raise
               end;
             end;
           end
           else
             //debugln('Found a literal [');
             AddToMask(cMask_SetStart);
          end;

          otherwise
          begin
            //it must be a "simple cMask token", or a mask literal at this point
            if (Length(CP) = 1) and (CP[1] in Simple_cMask_Tokens) then
            begin
              AMaskedTypeCase := UpDownToMaskedTypeCase(InUp, InDown);
              AMaskedType := cMaskToMaskedTypeTable[CP[1], AMaskedTypeCase];
              AddToMask(AMaskedType);
            end
            else
              //It's a MaskLiteral
              AddToMask(CP);
          end;
        end;//case CP of
      end; //not Special
      Inc(i);
    end; //while

    //debugln('TCustomMaskEdit.SetEditMask: Internal Mask:');
    //debugln(DbgS(FMask));

    FFirstFreePos := 1;
    //Determine first position where text can be entered (needed for DeleteChars()
    while (FFirstFreePos <= FMaskLength) and IsLiteral(FFirstFreePos)  do Inc(FFirstFreePos);
    if (FMaskLength > 0) then
    begin
      SetCharCase(ecNormal);
      SetNumbersOnly(False);
    end;
    //SetMaxLegth must be before Clear, otherwise Clear uses old MaxLength value!
    SetMaxLength(FMaskLength);
    Clear;
    FTextOnEnter := inherited RealGetText;
  end; //FRealMask<>Value
end;

procedure TCustomMaskEdit.ParseSet(const S: String; var i: integer; SUlen: PtrInt; out ACharSet: TSysCharSet;
                                   out IsNegative, IsOptional: Boolean);
var
  SetClosed, InRange, Special: Boolean;
  LastChar, Current: Char;
  CP: TUtf8Char;

  procedure AddToCharSet(AFirst, ALast: Char);
  var
    C: Char;
  begin
    for C := AFirst to ALast do
      Include(ACharSet, C);
  end;

begin
  SetClosed := False;
  ACharSet := [];
  IsNegative := False;
  IsOptional := False;
  Special := False;
  LastChar := #0;
  InRange := False;

  while (not SetClosed) and (i < SUlen) do
  begin//while
    Inc(i);
    CP := GetCodePoint(S, i);
    if (Length(CP) <> 1) then
      raise EInvalidEditMask.Create(SIllegalCharInSet);
    Current := CP[1];
    if Special then
    begin
      if not InRange then
        AddToCharSet(Current, Current)
      else
        AddToCharSet(LastChar, Current);
      InRange := False;
      Special := False;
    end
    else
    begin//not Special
      case Current of
        cMask_SpecialChar:
        begin
          Special := True;
        end;

        cMask_SetNegate:
        begin
          if not IsNegative and (ACharSet = []) then
          begin
            //debugln('IsNegative := True');
            IsNegative := True
          end
          else
          begin
            if not InRange then
              AddToCharSet(Current, Current)
            else
              AddToCharSet(LastChar, Current);
            InRange := False;
          end;
        end;

        cMask_SetOptional:
        begin
          if not IsOptional and not IsNegative and (ACharSet = []) then
          begin
            //debugln('IsNegative := True');
            IsOptional := True
          end
          else
          begin
            if not InRange then
              AddToCharSet(Current, Current)
            else
              AddToCharSet(LastChar, Current);
            InRange := False;
          end;
        end;

        cMask_SetRange:
        begin
          if InRange then
            raise EInvalidEditMask.Create(SIllegalRangeChar);
          if (ACharSet = []) or ((i < SUlen) and (GetCodePoint(S, i+1) = cMask_SetEnd)) then
          //be lenient, if it appears as last token in a set, accept it as a character for CharSet
          begin
            //debugln('Adding - to set');
            Include(ACharSet, cMask_SetRange);
          end
          else
          begin
            //debugln('Start range');
            InRange := True;
          end;
        end;

        cMask_SetEnd:
        begin
          //debugln('Set closed:');
          if (ACharSet = []) then
            raise EInvalidEditMask.Create(SEmptySet);
          //debugln(['IsNegative=',IsNegative]);
          InRange := False;
          SetClosed := True;
        end;

        otherwise
        begin
          if not InRange then
            AddToCharSet(Current, Current)
          else
            AddToCharSet(LastChar, Current);
          InRange := False;
        end; //otherwise
      end;//case
    end;//not Special
    if not InRange and not Special then
      LastChar := Current;

  end;//while
  if not SetClosed then
    raise EInvalidEditMask.Create(SUnclosedSet);
end;



// Return if mask is selected
function TCustomMaskEdit.GetIsMasked : Boolean;
begin
  Result := (FMaskLength > 0);
end;

procedure TCustomMaskEdit.SetModified(AValue: Boolean);
begin
  inherited Modified := AValue;
end;


// Set the current Space Char
procedure TCustomMaskEdit.SetSpaceChar(Value : Char);
Var
  S      : String;
  I      : Integer;
  OldValue: TUtf8Char;
Begin
  if (Value <> FSpaceChar) (* and ((Not IsMaskChar(Value)) {or (CharToMask(Value) = Char_Space)}) *) then
  begin
    OldValue := FSpaceChar;
    FSpaceChar := Value;
    if IsMasked then
    begin
      S := inherited RealGetText;
      for I := 1 to Utf8Length(S) do
      begin
        if (GetCodePoint(S,i) = OldValue) and (not IsLiteral(i)) then SetCodePoint(S,i,FSpaceChar);
        //also update FTextOnEnter to reflect new SpaceChar!
        if (GetCodePoint(FTextOnEnter,i) = OldValue) and (not IsLiteral(i)) then SetCodePoint(FTextOnEnter,i,FSpaceChar);
      end;
      //FCurrentText := S;
      RealSetTextWhileMasked(S);
      CheckCursor;
    end;
  end;
end;




// Set the cursor position and select the char in the control
procedure TCustomMaskEdit.SetCursorPos;
begin
  //no need to do this when in designmode, it actually looks silly if we do
  if not (csDesigning in ComponentState) then
  begin
    if FCharPos < 1 then FCharPos := 1
    else if (FCharPos > FMaskLength + 1) then FCharPos := FMaskLength + 1;
    if (FCharPos > FMaskLength) or not Focused then
      SetSel(FCharPos-1, FCharPos-1)
    else
      SetSel(FCharPos-1, FCharPos);
  end;
end;

//Move to next char, skip any mask-literals
procedure TCustomMaskEdit.SelectNextChar;
begin
  if (FCharPos) > FMaskLength then Exit;
  Inc(FCharPos);
  While (FCharPos < FMaskLength) and (IsLiteral(FCharPos)) do
  begin
    Inc(FCharPos);
  end;
  if (FCharPos <= FMaskLength) and IsLiteral(FCharPos) then Inc(FCharPos);
  SetCursorPos;
end;

//Move to previous char, skip any mask-literals
procedure TCustomMaskEdit.SelectPrevChar;
var
  P: LongInt;
  AStart: Integer;
  AStop: Integer;
begin
  GetSel(AStart, AStop);
  if (FCharPos = 1) and (AStop - AStart <= 1) then Exit;
  P := FCharPos;
  Dec(FCharPos);
  While (FCharPos > 1) and IsLiteral(FCharPos) do
  begin
    Dec(FCharPos);
  end;
  if (FCharPos = 1) and (P <> 1) and IsLiteral(FCharPos) then FCharPos := P;
  SetCursorPos;
end;


procedure TCustomMaskEdit.SelectFirstChar;
begin
  FCharPos := 1;
  SetCursorPos;
end;

procedure TCustomMaskEdit.GotoEnd;
begin
  FCharPos := FMaskLength + 1;
  SetCursorPos;
end;

//Jump to next period or comma if possible, otherwise do nothing
procedure TCustomMaskEdit.JumpToNextDot(Dot: Char);
{
  Jumping occurs only if
  - Dot must be in the mask
  - There is a Dot after the current cursorposition
  - If the mask contains both periods and comma's, only the first one
    is jumpable
  - There is no literal after the next dot
  - The next dot is not the last character in the mask
}
  function MaskPos(Sub: TUtf8Char; Start: Integer): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := Start to FMaskLength do
    begin
      if (GetMask(i).MaskType = Char_IsLiteral) and (GetMask(i).Literal = Sub) then
      begin
        Result := i;
        exit;
      end;
    end;
  end;

var
  HasNextDot, HasCommaAndPeriod, CanJump: Boolean;
  P, P2: Integer;
begin
  if not (Dot in [Period, Comma]) then Exit;
  P := MaskPos(Dot, FCharPos);
  HasNextDot := P > 0;
  If (Dot = Period) then
  begin
    P2 := MaskPos(Comma, 1);
    HasCommaAndPeriod := HasNextDot and (P2 >0)
  end
  else
  begin
    P2 := MaskPos(Period, 1);
    HasCommaAndPeriod := HasNextDot and (P2 >0);
  end;
  if HasCommaAndPeriod then
  begin
    //When mask has both period and comma only the first occurrence is jumpable
    if P2 < P then HasNextDot := False;
  end;
  CanJump := HasNextDot and (P < FMaskLength) and (not IsLiteral(P+1));
  if CanJump then
  begin
    FCharPos := P+1;
    SetCursorPos;
  end;
end;

function TCustomMaskEdit.HasSelection: Boolean;
begin
  Result := (GetSelLength() > 0);
end;

//Return True if Selection > 1, this influences the handling of Backspace
function TCustomMaskEdit.HasExtSelection: Boolean;
begin
  Result := (GetSelLength() > 1);
end;


// Get the current selection
procedure TCustomMaskEdit.GetSel(out _SelStart: Integer; out _SelStop: Integer);
begin
  _SelStart:= GetSelStart();
  _SelStop:= _SelStart + GetSelLength();
end;

// Set the current selection
procedure TCustomMaskEdit.SetSel(const _SelStart: Integer; _SelStop: Integer);
begin
  //in GTK if SelLength <> 0 then setting SelLength also changes SelStart
  SetSelLength(0);
  SetSelStart(_SelStart);
  SetSelLength(_SelStop - _SelStart);
end;


//Return if the index passed contains a literal in FMask (so it cannot be altered)
function TCustomMaskEdit.IsLiteral(Index: Integer): Boolean;
begin
  Result := (GetMask(Index).MaskType in [Char_IsLiteral, Char_HourSeparator, Char_DateSeparator]);
end;


//Return if Value matches the EditMask
function TCustomMaskEdit.TextIsValid(const Value: String): Boolean;
var
  i: Integer;
begin
  Result := False;
  if (Utf8Length(Value) <> FMaskLength) then
  begin
    //DebugLn('  Utf8Length(Value) = ',DbgS(Utf8Length(Value)),' FMaskLength = ',DbgS(FMaskLength));
    Exit; //Actually should never happen??
  end;
  for i := 1 to FMaskLength do
  begin
    if not CharMatchesMask(GetCodePoint(Value, i), i) then Exit;
  end;
  Result := True;
end;


function TCustomMaskEdit.CharMatchesMask(const Ch: TUtf8Char; const Position: Integer): Boolean;
var
  Current: tMaskedType;
  Ok: Boolean;
begin
  Result := False;
  Current := GetMask(Position).MaskType;
  case Current Of
    Char_Number              : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'9',FSpaceChar{#32}]);
    Char_NumberFixed         : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'9']);
    Char_NumberPlusMin       : OK := (Length(Ch) = 1) and (Ch[1] in ['0'..'9','+','-',FSpaceChar{#32}]);
    Char_Letter              : OK := (Length(Ch) = 1) and (Ch[1] In ['a'..'z', 'A'..'Z',FSpaceChar{#32}]);
    Char_LetterFixed         : OK := (Length(Ch) = 1) and (Ch[1] In ['a'..'z', 'A'..'Z']);
    Char_LetterUpCase        : OK := (Length(Ch) = 1) and (Ch[1] In ['A'..'Z',FSpaceChar{#32}]);
    Char_LetterDownCase      : OK := (Length(Ch) = 1) and (Ch[1] In ['a'..'z',FSpaceChar{#32}]);
    Char_LetterFixedUpCase   : OK := (Length(Ch) = 1) and (Ch[1] In ['A'..'Z']);
    Char_LetterFixedDownCase : OK := (Length(Ch) = 1) and (Ch[1] In ['a'..'z']);
    Char_AlphaNum            : OK := (Length(Ch) = 1) and (Ch[1] in ['a'..'z', 'A'..'Z', '0'..'9',FSpaceChar{#32}]);
    Char_AlphaNumFixed       : OK := (Length(Ch) = 1) and (Ch[1] in ['a'..'z', 'A'..'Z', '0'..'9']);
    Char_AlphaNumUpCase      : OK := (Length(Ch) = 1) and (Ch[1] in ['A'..'Z', '0'..'9',FSpaceChar{#32}]);
    Char_AlphaNumDownCase    : OK := (Length(Ch) = 1) and (Ch[1] in ['a'..'z', '0'..'9',FSpaceChar{#32}]);
    Char_AlphaNumFixedUpCase : OK := (Length(Ch) = 1) and (Ch[1] in ['A'..'Z', '0'..'9']);
    Char_AlphaNumFixedDowncase:OK := (Length(Ch) = 1) and (Ch[1] in ['a'..'z', '0'..'9']);
    Char_All                 : OK := True;
    Char_AllFixed            : OK := (Ch <> FSpaceChar);
    Char_AllUpCase           : OK := (Ch = Utf8UpperCase(Ch));
    Char_AllDownCase         : OK := (Ch = Utf8LowerCase(Ch));
    Char_AllFixedUpCase      : OK := (Ch <> FSpaceChar) and (Ch = Utf8UpperCase(Ch));
    Char_AllFixedDownCase    : OK := (Ch <> FSpaceChar) and (Ch = Utf8LowerCase(Ch));
   {Char_Space               : OK := (Length(Ch) = 1) and (Ch in [' ', '_']);  //not Delphi compatible, see notes above}
    Char_HourSeparator       : OK := (Ch = DefaultFormatSettings.TimeSeparator);
    Char_DateSeparator       : OK := (Ch = DefaultFormatSettings.DateSeparator);
    Char_Hex                 : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','a'..'f','A'..'F',FSpaceChar{#32}]);
    Char_HexFixed            : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','a'..'f','A'..'F']);
    Char_HexUpCase           : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','A'..'F',FSpaceChar{#32}]);
    Char_HexDownCase         : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','a'..'f',FSpaceChar{#32}]);
    Char_HexFixedUpCase      : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','A'..'F']);
    Char_HexFixedDownCase    : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','a'..'f']);
    Char_Binary              : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'1',FSpaceChar{#32}]);
    Char_BinaryFixed         : OK := (Length(Ch) = 1) and (Ch[1] In ['0'..'1']);
    Char_SetFixed            : Ok := (Length(Ch) = 1) and (Ch[1] in FMask[Position].CharSet);
    Char_Set                 : Ok := (Ch = FSpaceChar) or ((Length(Ch) = 1) and (Ch[1] in FMask[Position].CharSet));
    Char_SetNegateFixed      : OK := not ((Length(Ch) = 1) and (Ch[1] in FMask[Position].CharSet));
    Char_IsLiteral           : OK := (Ch = FMask[Position].Literal);  // no need to use GetMask() here, since FMask[FPosition] has already been validated
  end;//case
  //DebugLn('Position = ',DbgS(Position),' Current = ',DbgS(Current),' Ch = "',Ch,'" Ok = ',DbgS(Ok));
  Result := Ok;
end;


//Set text in the control with FChangeAllowed flag set appropriately
procedure TCustomMaskEdit.RealSetTextWhileMasked(const Value: TCaption);
begin
  if (Value <> inherited RealGetText) then
  begin
    FInRealSetTextWhileMasked := True;
    FChangeAllowed := True;
    FCurrentText := Value;
    //protect resetting FChangeAllowed := False against unhandled exceptions in user's
    //OnChange, otherwise risk leaving the control in an "unsafe" state regarding text changes
    try
      Inherited RealSetText(Value);
    finally
      FChangeAllowed := False;
      FInRealSetTextWhileMasked := False;
    end;//finally
  end;
end;

// Save current mask, then disable mask
// This gives developers the possibility to set any text in the control _without_ messing up the control
// Wether or not the function succeeds: NewText will be set as the new text of the control
// No need to save FMaskSave and FTrimtype, they are only set in SetMask, which sets MaskIsPushed := False
function TCustomMaskEdit.DisableMask(const NewText: String): Boolean;
begin
  if IsMasked and (not FMaskIsPushed) then
  begin
    ClearInternalMask(FSavedMask, FSavedMaskLength);
    System.Move(FMask[1], FSavedMask[1], SizeOf(TInternalMask));
    FSavedMaskLength := FMaskLength;
    ClearInternalMask(FMask, FMaskLength);
    FMaskIsPushed := True;
    SetMaxLength(0);
    Result := True;
  end
  else
  begin
    Result := False;
  end;
  Text := NewText;
end;

procedure TCustomMaskEdit.DoValidationError;
begin
  if Assigned(FOnValidationError) then
    FOnValidationError(Self);
end;

// Restore a saved mask
function TCustomMaskEdit.RestoreMask(const NewText: String): Boolean;
begin
  if FMaskIsPushed and (not IsMasked) then
  begin
    FMaskIsPushed := False;
    SetCharCase(ecNormal);
    ClearInternalMask(FMask, FMaskLength);
    System.Move(FSavedMask[1], FMask[1], SizeOf(TInternalMask));
    FMaskLength := FSavedMaskLength;
    ClearInternalMask(FSavedMask, FSavedMaskLength);
    SetMaxLength(FMaskLength);
    FTextOnEnter := inherited RealGetText;
    Result := True;
  end
  else
  begin
    Result := False;
  end;
  // if NewText = old Text AND the control is now masked,
  // then "Text := NewText" will do nothing,
  // and NO mask will appear, so Clear first ...
  if IsMasked then Clear;
  Text := NewText;
end;

procedure TCustomMaskEdit.RealSetText(const AValue: TCaption);
begin
  //Setting Text while loading has unwanted side-effects
  if (csLoading in ComponentState) {and (not FSettingInitialText)} then
  begin
    FInitialText := AValue;
    Exit;
  end;
  if not IsMasked then
    inherited RealSetText(AValue)
  else
    SetTextApplyMask(AValue);
end;

function TCustomMaskEdit.RealGetText: TCaption;
begin
  Result := inherited RealGetText;  //don't call GetEditText here (issue #0026924)
  if IsMasked then
    Result := GetTextWithoutMask(Result);
end;

// Set the actual Text
procedure TCustomMaskEdit.SetTextApplyMask(Value: TCaption);
var
  S: TCaption;
Begin
  if IsMasked then
  begin
    try
      FTextChangedBySetText := True;
      if (Value = '') then
      begin
        Clear;
        Exit;
      end;
      S := ApplyMaskToText(Value);
      RealSetTextWhileMasked(S);
    finally
      FTextChangedBySetText := False;
    end; //try..finally
  end//Ismasked
  else
  begin//not IsMasked
    RealSetTextWhileMasked(Value);
  end;
End;


function TCustomMaskEdit.GetEditText: string;
begin
  Result := Inherited RealGetText;
end;



procedure TCustomMaskEdit.SetEditText(const AValue: string);
//Note: This is not Delphi compatible, but by design
//Delphi lets you just set EditText of any length, which is extremely dangerous!
var
  S: String;
  i: Integer;
  {$if fpc_fullversion < 30202}
  OldS: String;
  ULen: PtrInt;
  ClearCh: TUTF8Char;
  {$endif}
begin
  if (not IsMasked) then
  begin
    Inherited RealsetText(AValue);
  end
  else
  begin
    //Make sure we don't copy more or less text into the control than FMask allows for
    S := Utf8Copy(AValue, 1, FMaskLength);
    //Restore all MaskLiterals, or we will potentially leave the control
    //in an unrecoverable state, eventually crashing the app
    for i := 1 to Utf8Length(S) do
      if IsLiteral(i) then SetCodePoint(S,i,ClearChar(i));
    //Pad resulting string with ClearChar if text is too short
    {$if fpc_fullversion >= 30202}
    while Utf8Length(S) < FMaskLength do S := S + ClearChar(Utf8Length(S)+1);
    {$else}
    //workaround for fpc issue #0038337
    //Utf8Length(S) corrupts S, so concatenation with ClearChar() fails, leading to an endless loop.
    //See issue #0038505
    while Utf8Length(S) < FMaskLength do
    begin
      OldS := S;
      ULen := Utf8Length(S);
      ClearCh := ClearChar(Ulen+1);
      //DbgOut(['TCustomMaskEdit.SetEditText: S="',S,'", Utf8Length(S)=',ULen,', FMaskLength=',FMaskLength,', ClearChar(',Ulen+1,')=',ClearCh]);
      S := OldS + ClearCh;
      //debugln(' --> S:',S);
    end;
    {$endif}
    RealSetTextWhileMasked(S);
  end;
end;


// Clear (virtually) a single Utf8 char in position Position
function TCustomMaskEdit.ClearChar(Position : Integer) : TUtf8Char;
begin
  //For Delphi compatibilty, only literals remain, all others will be blanked
  case GetMask(Position).MaskType Of
    {Char_Space               : Result := #32; //FSpaceChar?; //not Delphi compatible, see notes above}
    Char_HourSeparator        : Result := DefaultFormatSettings.TimeSeparator;
    Char_DateSeparator        : Result := DefaultFormatSettings.DateSeparator;
    Char_IsLiteral            : Result := FMask[Position].Literal; //No need to use GetMask, FMask[Position] already has been validated
    otherwise
      Result := FSpaceChar;
  end;
end;

//Insert a single Utf8 char at the current position of the cursor
procedure TCustomMaskEdit.InsertChar(Ch : TUtf8Char);
Var
  S: String;
  i, SelectionStart, SelectionStop: Integer;
begin
  if CanInsertChar(FCharPos, Ch) then
  begin
    S := inherited RealGetText;
    if HasSelection then
    begin
      //replace slection with blank chars
      //don't do this via DeleteChars(True), since it will do an unneccesary
      //update of the control and 2 TextChanged's are triggerd for every char we enter
      GetSel(SelectionStart, SelectionStop);
      for i := SelectionStart + 1 to SelectionStop do SetCodePoint(S, i, ClearChar(i));
    end;
    SetCodePoint(S, FCharPos, Ch);
    RealSetTextWhileMasked(S);
    SelectNextChar;
  end
  else
  //If we have a selection > 1 (and cannot insert) then Delete the selected text: Delphi compatibility
  if HasExtSelection then DeleteSelected;
end;


//Check if a Utf8 char can be inserted at position Position, also do case conversion if necessary
function TCustomMaskEdit.CanInsertChar(Position: Integer; var Ch: TUtf8Char;
  IsPasting: Boolean = False): Boolean;
Var
  Current : tMaskedType;
Begin
  Result  := False;
  if (Position > FMaskLength) then
    Exit;
  Current := GetMask(Position).MaskType;

  // If in UpCase convert the input char
  if (Current = Char_LetterUpCase     ) Or
     (Current = Char_LetterFixedUpCase) Or
     (Current = Char_AllUpCase        ) Or
     (Current = Char_AllFixedUpCase   ) or
     (Current = Char_AlphaNumUpcase   ) or
     (Current = Char_AlphaNumFixedUpCase) or
     (Current = Char_HexUpCase          ) or
     (Current = Char_HexFixedUpCase     )
     //(Current = Char_SetUpCase          ) or
     //(Current = Char_SetNegateUpCase    )


     then
       Ch := Utf8UpperCase(Ch);

  // If in LowerCase convert the input char
  if (Current = Char_LetterDownCase     ) Or
     (Current = Char_LetterFixedDownCase) Or
     (Current = Char_AllDownCase        ) Or
     (Current = Char_AllFixedDownCase   ) or
     (Current = Char_AlphaNumDownCase   ) or
     (Current = Char_AlphaNumFixedDownCase ) or
     (Current = Char_HexDownCase           ) or
     (Current = Char_HexFixedDownCase      )
     //(Current = Char_SetDownCase           ) or
     //(Current = Char_SetNegateDownCase     )
     then
       Ch := Utf8LowerCase(Ch);

  // Check the input (check the valid range)
  case Current Of
       Char_Number,
       Char_NumberFixed         : Result := (Length(Ch) = 1) and (Ch[1] In ['0'..'9']);
       Char_NumberPlusMin       : Result := (Length(Ch) = 1) and (Ch[1] in ['0'..'9','+','-',#32]); //yes Delphi allows a space here
       Char_Letter,
       Char_LetterFixed         : Result := (Length(Ch) = 1) and (Ch[1] In ['a'..'z', 'A'..'Z']);
       Char_LetterUpCase,
       Char_LetterFixedUpCase   : Result := (Length(Ch) = 1) and (Ch[1] In ['A'..'Z']);
       Char_LetterDownCase,
       Char_LetterFixedDownCase : Result := (Length(Ch) = 1) and (Ch[1] In ['a'..'z']);
       Char_AlphaNum,
       Char_AlphaNumFixed       : Result := (Length(Ch) = 1) and (Ch[1] in ['a'..'z', 'A'..'Z', '0'..'9']);
       Char_AlphaNumUpCase,
       Char_AlphaNumFixedUpCase : Result := (Length(Ch) = 1) and (Ch[1] in ['A'..'Z', '0'..'9']);
       Char_AlphaNumDownCase,
       Char_AlphaNumFixedDowncase:Result := (Length(Ch) = 1) and (Ch[1] in ['a'..'z', '0'..'9']);
       Char_All,
       Char_AllFixed,
       Char_AllUpCase,
       Char_AllDownCase,
       Char_AllFixedUpCase,
       Char_AllFixedDownCase    : Result := True;
       Char_HourSeparator       : Result := (Ch = DefaultFormatSettings.TimeSeparator);
       Char_DateSeparator       : Result := (Ch = DefaultFormatSettings.DateSeparator);
       Char_Hex,
       Char_HexFixed            : Result := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','a'..'f','A'..'F']);
       Char_HexUpCase,
       Char_HexFixedUpCase      : Result := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','A'..'F']);
       Char_HexDownCase,
       Char_HexFixedDownCase    : Result := (Length(Ch) = 1) and (Ch[1] In ['0'..'9','a'..'f']);
       Char_Binary,
       Char_BinaryFixed         : Result := (Length(Ch) = 1) and (Ch[1] In ['0'..'1']);
       Char_Set, Char_SetFixed  : Result := (Length(Ch) = 1) and (Ch[1] in FMask[Position].CharSet);
       Char_SetNegateFixed      : Result := not ((Length(Ch) = 1) and (Ch[1] in FMask[Position].CharSet));
       Char_IsLiteral           : Result := False;
       Char_Invalid:
         Raise EDBEditError.CreateFmt('MaskEdit Internal Error.'^m' Found uninitialized MaskType "Char_Invalid" at index %d',[Position]);
  end;
  //while typing a space is not allowed in these cases, whilst pasting Delphi allows it nevertheless
  if not Result and IsPasting and (Ch = #32) and
    (Current in [Char_Number, Char_Letter, Char_LetterUpCase, Char_LetterDownCase,
                 Char_AlphaNum, Char_AlphaNumUpCase, Char_AlphaNumDownCase,
                 Char_Hex, Char_HexUpCase, Char_HexDownCase, Char_Binary]) then
    Result := True;
end;


// Delete selected chars
procedure TCustomMaskEdit.DeleteSelected;
Var
  SelectionStart, SelectionStop, I : Integer;
  S: String;
begin
  if not HasSelection then Exit;
  GetSel(SelectionStart, SelectionStop);
  S := inherited RealGetText;
  for i := SelectionStart + 1 to SelectionStop do SetCodePoint(S, i,ClearChar(i));
  RealSetTextWhileMasked(S);
  SetCursorPos;
end;


// Delete a single char from position
procedure TCustomMaskEdit.DeleteChars(NextChar : Boolean);
begin
  if NextChar then
  begin//VK_DELETE
    if HasSelection then
    begin
      DeleteSelected;
      if IsLiteral(FCharPos) then
        SelectNextChar;
    end
    else
    begin
      //cannot delete beyond length of string
      if (FCharPos < FMaskLength + 1) then
      begin
        //This will select the appropriate char in the control
        SetCursorPos;
        DeleteSelected;
      end;
    end;
  end
  else
  begin//VK_BACK
    //if selected text > 1 char then delete selection
    if HasExtSelection then
    begin
      DeleteSelected;
      if IsLiteral(FCharPos) then
        SelectNextChar;
    end
    else
    begin
      //cannot backspace if we are at beginning of string, or if all chars in front are MaskLiterals
      if FCharPos > FFirstFreePos then
      begin
        //This will select the previous character
        //If there are MaskLiterals just in front of the current position, they will be skipped
        //and the character in front of them will be deleted (Delphi compatibility)
        SelectPrevChar;
        DeleteSelected;
      end;
    end;
  end;
end;

class procedure TCustomMaskEdit.WSRegisterClass;
begin
  inherited WSRegisterClass;
  RegisterPropertyToSkip(TCustomMaskEdit, 'TextHintFontColor','Used in a previous version of Lazarus','');
  RegisterPropertyToSkip(TCustomMaskEdit, 'TextHintFontStyle','Used in a previous version of Lazarus','');
end;

function TCustomMaskEdit.ApplyMaskToText(Value: TCaption): TCaption;
{ This tries to mimic Delphi behaviour (D3):
  - if mask contains no literals text is set, if necessary padded with blanks,
    LTR or RTL depending on FTrimType
  - if mask contains literals then we search for matching literals in text and
    process each "segment" between matching maskliterals, trimming or padding
    LTR or RTL depending on FTrimType, until there is no more matching maskliteral
    Some examples to clarify:
    EditMask        Text to be set    Result
    99              1                 1_
    !99             1                 _1
    cc-cc           1-2               1_-2_
    !cc-cc          1-2               _1-_2
    cc-cc@cc        1-2@3             1_-2_@3_
                    12@3              12-__@__
    cc-cc@cc        123-456@789       12-45@78
    !cc-cc@cc       123-456@789       23-56@89
    This feauture seems to be invented for easy use of dates:

    99/99/00        23/1/2009         23/1_/20  <- if your locale DateSeparator = '/'
    !99/99/00       23/1/2009         23/_1/09  <- if your locale DateSeparator = '/'

  - The resulting text will always have length = FMaskLength
  - The text that is set, does not need to validate
}
//Helper functions
  Function FindNextMaskLiteral(const StartAt: Integer; out FoundAt: Integer; out ALiteral: TUtf8Char): Boolean;
  var i: Integer;
  begin
    Result := False;
    for i := StartAt to FMaskLength do
    begin
      if IsLiteral(i) then
      begin
        FoundAt := i;
        ALiteral := ClearChar(i);//don't use FMask[i].Literal here, since it is EmptyStr for Char_HourSeparator and Char_DateSeparator; Issue #0038606
        Result := True;
        Exit;
      end;
    end;
  end;
  Function FindMatchingLiteral(const Value: String; const ALiteral: TUtf8Char; out FoundAt: Integer): Boolean;
  begin
    FoundAt := Utf8Pos(ALiteral, Value);
    Result := (FoundAt > 0);
  end;

Var
  S                   : String;
  I, J                : Integer;
  mPrevLit, mNextLit  : Integer; //Position of Previous and Next literal in FMask
  vNextLit            : Integer; //Position of next matching literal in Value
  HasNextLiteral,
  HasMatchingLiteral,
  Stop                : Boolean;
  Literal             : TUtf8Char;
  Sub                 : String;
begin
  //First setup a "blank" string that contains all literals in the mask
  if not IsMasked then
  begin
    Result := Value;
    Exit;
  end;
  S := '';
  for I := 1 To FMaskLength do  S := S + ClearChar(I);

  if FMaskSave then
  begin
    mPrevLit := 0;
    Stop := False;
    HasNextLiteral := FindNextMaskLiteral(mPrevLit+1, mNextLit, Literal);
    //if FMask starts with a literal, then the first CodePoint of Value must be that literal
    if HasNextLiteral and (mNextLit = 1) and (GetCodePoint(Value, 1) <> Literal) then Stop := True;
    //debugln('HasNextLiteral = ',dbgs(hasnextliteral),', Stop = ',dbgs(stop));
    While not Stop do
    begin
      if HasNextLiteral then
      begin
        HasMatchingLiteral := FindMatchingLiteral(Value, Literal, vNextLit);
        //debugln('mPrevLit = ',dbgs(mprevlit),' mNextLit = ',dbgs(mnextlit));
        //debugln('HasMatchingLiteral = ',dbgs(hasmatchingliteral));
        if HasMatchingLiteral then
        begin
          //debugln('vNextLit = ',dbgs(vnextlit));
          Sub := Utf8Copy(Value, 1, vNextLit - 1); //Copy up to, but not including matching literal
          Utf8Delete(Value, 1, vNextLit); //Remove this bit from Value (including matching literal)
          if (Utf8Length(Value) = 0) then Stop := True;
          //debugln('Sub = "',Sub,'", Value = "',Value,'"');
        end
        else
        begin//HasMatchingLiteral = False
          Stop := True;
          Sub := Value;
          Value := '';
          //debugln('Sub = "',Sub,'", Value = "',Value,'"');
        end;
        //fill S between vPrevLit + 1 and vNextLit - 1, LTR or RTL depending on FTrimType
        if (FTrimType = metTrimRight) then
        begin
          j := 1;
          for i := (mPrevLit + 1) to (mNextLit - 1) do
          begin
            if (J > Utf8Length(Sub)) then Break;
            if (GetCodePoint(Sub,j) = #32) then SetCodePoint(S,i,FSpaceChar) else SetcodePoint(S,i,GetCodePoint(Sub,j));
            Inc(j);
          end;
        end
        else
        begin//FTrimType = metTrimLeft
          j := Utf8Length(Sub);
          for i := (mNextLit - 1) downto (mPrevLit + 1) do
          begin
            if (j < 1) then Break;
            if (GetCodePoint(Sub,j) = #32) then SetCodePoint(S,i,FSpaceChar) else SetCodePoint(S,i, GetCodePoint(Sub,j));
            Dec(j);
          end;
        end;
        //debugln('S = ',S);
      end
      else
      begin//HasNextLiteral = False
        //debugln('No more MaskLiterals at this point');
        //debugln('mPrevLit = ',dbgs(mprevlit));
        Stop := True;
        Sub := Value;
        Value := '';
        //debugln('Sub = "',Sub,'", Value = "',Value,'"');
        //fill S from vPrevLit + 1 until end of FMask, LTR or RTL depending on FTrimType
        if (FTrimType = metTrimRight) then
        begin
          j := 1;
          for i := (mPrevLit + 1) to FMaskLength do
          begin
            //debugln('  i = ',dbgs(i),'  j = ',dbgs(j));
            if (j > Utf8Length(Sub)) then Break;
            if (GetCodePoint(Sub,j) = #32) then SetCodePoint(S,i,FSpaceChar) else SetCodePoint(S,i, GetCodePoint(Sub,j));
            //debugln('  Sub[j] = "',Sub[j],'" -> S = ',S);
            Inc(j);
          end;
        end
        else
        begin//FTrimType = metTrimLeft
          j := Utf8Length(Sub);
          for i := FMaskLength downto (mPrevLit + 1) do
          begin
            //debugln('  i = ',dbgs(i),'  j = ',dbgs(j));
            if (j < 1) then Break;
            if (GetCodePoint(Sub,j) = #32) then SetCodePoint(S,i,FSpaceChar) else SetCodePoint(S,i, GetCodePoint(Sub,j));
            //debugln('  Sub[j] = "',Sub[j],'" -> S = ',S);
            Dec(j);
          end;
        end;
        //debugln('S = ',S);
      end;
      //debugln('Stop = ',dbgs(stop));
      if not Stop then
      begin
        mPrevLit := mNextLit;
        HasNextLiteral := FindNextMaskLiteral(mPrevLit + 1, mNextLit, Literal);
      end;
    end;//while not Stop
  end//FMaskSave = True
  else
  begin//FMaskSave = False
    if FTrimType = metTrimRight then
    begin
      //fill text from left to rigth, skipping MaskLiterals
      j := 1;
      for i := 1 to FMaskLength do
      begin
        if not IsLiteral(i) then
        begin
          if (GetCodePoint(Value,j) = #32) then SetCodePoint(S,i,FSpaceChar) else SetCodePoint(S,i, GetCodePoint(Value,j));
          Inc(j);
          if j > Utf8Length(Value) then Break;
        end;
      end;
    end
    else
    begin
      //fill text from right to left, skipping MaskLiterals
      j := Utf8Length(Value);
      for i := FMaskLength downto 1 do
      begin
        if not IsLiteral(i) then
        begin
          if (GetCodePoint(Value,j) = #32) then SetCodePoint(S,i,FSpaceChar) else SetCodePoint(S,i, GetCodePoint(Value,j));
          Dec(j);
          if j < 1 then Break;
        end;
      end;
    end;
  end;//FMaskSave = False
  Result := S;
end;

function TCustomMaskEdit.CanShowEmulatedTextHint: Boolean;
begin
  if IsMasked then
    Result := False
  else
    Result := inherited CanShowEmulatedTextHint;
end;



// Get the actual Text
function TCustomMaskEdit.GetTextWithoutMask(Value: TCaption): TCaption;
{
  Replace al FSPaceChars with #32
  If FMaskSave = False then do trimming of spaces and remove all maskliterals
}
var
  S: String;
  i: Integer;
Begin
  S := StringReplace(Value, FSpaceChar, #32, [rfReplaceAll]);
  //FSpaceChar can be used as a literal in the mask, so put it back
  for i := 1 to FMaskLength do
  begin
    if IsLiteral(i) and (FMask[i].Literal = FSpaceChar) then   //IsLiteral(i) alrady validates FMask[i], so this is safe
    begin
      SetCodePoint(S, i, FSpaceChar);
    end;
  end;
  if not FMaskSave then
  begin
    for i := 1 to FMaskLength do
    begin
      if IsLiteral(i) then SetCodePoint(S, i, #1); //We know this char can never be in Text, so this is safe
    end;
    S := StringReplace(S, #1, '', [rfReplaceAll]);
    //Trimming only occurs if FMaskSave = False
    case FTrimType of
      metTrimLeft : S := TrimLeft(S);
      metTrimRight: S := TrimRight(S);
    end;//case
  end;
  Result := S;
End;

{
  Replace al FSPaceChars with #32
  Leave all mask literals in place
  Needed by FormatMaskText
}
function TCustomMaskEdit.GetTextWithoutSpaceChar(Value: TCaption): TCaption;
var
  i: Integer;
Begin
  Result := StringReplace(Value, FSpaceChar, #32, [rfReplaceAll]);
  //FSpaceChar can be used as a literal in the mask, so put it back
  for i := 1 to FMaskLength do
  begin
    if IsLiteral(i) and (FMask[i].Literal = FSpaceChar) then  //IsLiteral(i) already validates FMask[i], so this is safe
    begin
      SetCodePoint(Result, i, FSpaceChar);
    end;
  end;
end;


// Respond to Text Changed message
procedure TCustomMaskEdit.TextChanged;
{ Purpose: to avoid messing up the control by
  - cut/paste/clear via OS context menu
    (we try to catch these messages and handle them,
    but this is not garantueed to work)
  - dragging selected text in the control with the mouse
  If one of these happens, then the internal logic of cursorpositioning,
  inserting characters is messed up.
  So, we simply restore the text from our backup: FCurrenText
}
begin
  if (not IsMasked) or FChangeAllowed then
  begin
    Inherited TextChanged;
  end
  else
  begin//Undo changes: restore with value of FCurrentText
    //we do not call inherited TextChanged here, because the following RealSetTextWhileMasked
    //will trigger TextChanged with FChangeAllowed = True and inherited TextChanged is called then
    RealSetTextWhileMasked(FCurrentText);
    //Reset cursor to last known position
    SetCursorPos;
  end;
end;

procedure TCustomMaskEdit.Change;
begin
  //suppress OnChange when setting initiall values.
  if not FSettingInitialText then inherited Change;
end;

procedure TCustomMaskEdit.SetCharCase(Value: TEditCharCase);
begin
  if IsMasked then
    inherited SetCharCase(ecNormal)
  else
    inherited SetCharCase(Value);
end;


procedure TCustomMaskEdit.SetMaxLength(Value: Integer);
begin
  if IsMasked then
  begin
    inherited MaxLength := FMaskLength;
  end
  else
  begin
    inherited MaxLength := Value;
  end;
end;

function TCustomMaskEdit.GetMaxLength: Integer;
begin
  Result := inherited Maxlength;
end;

procedure TCustomMaskEdit.SetNumbersOnly(Value: Boolean);
begin
  if not IsMasked then
    inherited SetNumbersOnly(Value)
  else
    //NumersOnly interferes with masking
    inherited SetNumbersOnly(False);
end;

procedure TCustomMaskEdit.Loaded;
begin
  inherited Loaded;
  FSettingInitialText := True;
  if (FInitialMask <> '') then SetEditMask(FInitialMask);
  if (FInitialText <> '') then SetTextApplyMask(FInitialText);
  FSettingInitialText := False;
end;


// Respond to Paste message
procedure TCustomMaskEdit.LMPasteFromClip(var Message: TLMessage);
begin
  if (not IsMasked) or (ReadOnly) then
  begin
    Inherited ;
    Exit;
  end;
  //We handle this message ourself
  Message.Result := 0;
  PasteFromClipBoard;
end;



// Respond to Cut message
procedure TCustomMaskEdit.LMCutToClip(var Message: TLMessage);
begin
  if not IsMasked then
  begin
    inherited;
    Exit;
  end;
  //We handle this message ourself
  Message.Result := 0;
  CutToClipBoard;
end;


// Respond to Clear message
procedure TCustomMaskEdit.LMClearSel(var Message: TLMessage);
begin
  //DebugLn('TCustomMaskEdit.LMClearSel');
  if not IsMasked then
  begin
    inherited;
    Exit;
  end;
  //We handle this message ourself
  Message.Result := 0;
  DeleteSelected;
end;

function TCustomMaskEdit.EditCanModify: Boolean;
begin
  Result := True;
end;



procedure TCustomMaskEdit.Reset;
//Implements an Undo mechanisme from the moment of entering the control
begin
  if IsMasked and (not ReadOnly) then
  begin
    RealSetTextWhileMasked(FTextOnEnter);
    FCharPos := FFirstFreePos;
    SetCursorPos;
  end;
end;

//Moved from CMEnter message handler
procedure TCustomMaskEdit.DoEnter;
begin
  inherited DoEnter;
  if IsMasked then
  begin
    //debugln('TCustomMaskEdit.DoEnter: FValidationFailed = ',DbgS(FValidationFailed));
    FCharPos := GetSelStart + 1;
    //Only save FTextOnEnter if validation did not fail in last DoExit that occurred
    if not FValidationFailed then
      FTextOnEnter := inherited RealGetText
    else
      FValidationFailed := False;
    Modified := False;
    if (AutoSelect and not (csLButtonDown in ControlState)) then
    begin
      SelectAll;
      FCharPos := GetSelStart + 1;
    end
    else
    begin
    if ((FCharPos = 1) and (IsLiteral(1))) then
      //On entering select first editable char
      SelectNextChar
    else
      SetCursorPos;
    end;
  end;
end;



procedure TCustomMaskEdit.DoExit;
begin
  //debugln('TCustomMaskEdit.DoExit: FValidationFailed = ',DbgS(FValidationFailed));
  //First give OnExit a change to prevent a EDBEditError
  inherited DoExit;
  {$IFNDEF MASKEDIT_NOVALIDATEONEXIT}
  //Do not validate if FValidationFailed, or risk raising an exception while the previous exception was
  //not handled, resulting in an application crash
  if IsMasked and (FTextOnEnter <> inherited RealGetText) then
  begin
    //assume failure
    try
      //debugln('TCustomMaskedit.DoExit: try ValidateEdit');
      if (not FValidationFailed) then
      begin
        ValidateEdit;
        FValidationFailed := False;
      end ;
    finally
      //also check if control can be focussed, otherwise risk an exception while
      //handling an exception, issue #0030482
      if FValidationFailed and CanSetFocus then
      begin
        //debugln('TCustomMaskedit.DoExit: Validation failed');
        SetFocus;
        SelectAll;
      end;
    end;
  end;
  {$ENDIF}
end;



// Single key down procedure
procedure TCustomMaskEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  Inherited KeyDown(Key, Shift);
  // Not masked -> old procedure
  if not IsMasked then
  begin
    Exit;
  end;
  FCharPos := GetSelStart + 1;
  // shift and arrowkey -> old procedure
  if (ssShift in Shift) then
  begin
    if (Key = VK_LEFT) or (Key = VK_RIGHT) or
       (Key = VK_HOME) or (Key = VK_END) then
    begin
      Exit;
    end;
  end;
  //Escape Key
  if (Key = VK_ESCAPE) and (Shift = []) then
  begin
    if ((inherited RealGetText) <> FTextOnEnter) then
    begin
      Reset;
      Key := 0;
      Exit;
    end;
  end;
  //Handle clipboard and delete/backspace keys
  if (Key = VK_DELETE) then
  begin
    if not ReadOnly then
    begin
      if (Shift = [ssShift]) then
      begin//Cut
        CutToClipBoard;
      end
      else if (Shift = [ssModifier]) then
      begin//Clear
        DeleteSelected;
      end
      else if (Shift = []) then
      begin//Plain Delete
        //DeleteChars also works if SelLength = 0
        DeleteChars(True);
      end;
      Key := 0;
      Exit;
    end;
  end;
  if (Key = VK_BACK) then
  begin
    if not ReadOnly then
    begin
      if (Shift = [ssCtrl]) then
      begin//Clear
        DeleteSelected;
      end
      else
      if (Shift = [ssShift]) then
      begin
        CutToClipBoard;
      end
      else
      if (Shift = []) then
      begin
        DeleteChars(False);
      end;
      Key := 0;
      Exit;
    end;
  end;
  if (Key = VK_INSERT) then
  begin//Copy or Paste
    if (Shift = [ssShift]) then
    begin//Paste
      if not ReadOnly then
      begin
        PasteFromClipBoard;
      end;
    end
    else if (Shift = [ssModifier]) then
    begin//Copy
      CopyToClipBoard;
    end;
    Key := 0;
    Exit;
  end;
  if (Key = VK_C) and (Shift = [ssModifier]) then
  begin//Copy
    CopyToClipBoard;
    Key := 0;
    Exit;
  end;
  if (Key = VK_X) and (Shift = [ssModifier]) then
  begin//Cut
    if not ReadOnly then
    begin
      CutToClipBoard;
      Key := 0;
      Exit;
    end;
  end;
  if (Key = VK_V) and (Shift = [ssModifier]) then
  begin//Paste
    if not ReadOnly then
    begin
      PasteFromClipBoard;
      Key := 0;
      Exit;
    end;
  end;

  // Cursor movement
  //ATM we handle Ctrl+ArrowKey as if it were just ArrowKey
  if (Key = VK_LEFT) then
  begin
    SelectPrevChar;
    Key := 0;
    Exit;
  end;
  if (Key = VK_RIGHT) then
  begin
    SelectNextChar;
    Key := 0;
    Exit;
  end;
  if (Key = VK_HOME) then
  begin
    SelectFirstChar;
    Key := 0;
    Exit;
  end;
  if (Key = VK_END) then
  begin
    GotoEnd;
    Key := 0;
    Exit;
  end;
  // Cursor Up/Down -> not valid
  if (Key = VK_UP) or (Key = VK_DOWN) then
  begin
    Key := 0;
    Exit;
  end;
  if (Key = VK_A) and (Shift = [ssModifier]) then
  begin
    SelectAll;
    Key := 0;
    Exit;
  end;
end;


//Handle all keys from KeyPress and Utf8KeyPress here
procedure TCustomMaskEdit.HandleKeyPress(var Key: TUtf8Char);
begin
  if (not IsMasked) or ReadOnly then
  begin
    Exit;
  end;
  FCharPos := GetSelStart + 1;
  //If the cursor is on a MaskLiteral then go to the next writable position if a key is pressed (Delphi compatibility)
  if (FCharPos <= FMaskLength) and IsLiteral(FCharPos) then
  begin
    SelectNextChar;
    Key := EmptyStr;
  end
  else
  // Insert a char
  if  not ((Length(Key) = 1) and (Key[1] in [#0..#31])) then
  begin
    if ((Key = Period) or (Key = Comma)) and not (CanInsertChar(FCharPos, Key)) then
    begin//Try to jump to next period or comma, if at all possible
      JumpToNextDot(Key[1]);
    end
    else
    begin//any other key
      InsertChar(Key);
    end;
    //We really need to "eat" all keys we handle ourselves
    //(or widgetset will insert char second time)
    Key:= EmptyStr;
  end;
end;


procedure TCustomMaskEdit.KeyPress(var Key: Char);
var
  Utf8Key: TUtf8Char;
begin
  inherited KeyPress(Key);
  Utf8Key := Key;
  //All keys are handled in HandleKeyPress, which sets Utf8Key to ''
  HandleKeyPress(Utf8Key);
  if (Length(Utf8Key) = 0) then Key := #0;
end;

procedure TCustomMaskEdit.Utf8KeyPress(var UTF8Key: TUTF8Char);
begin
  inherited Utf8KeyPress(UTF8Key);
  //All keys are handled in HandleKeyPress, which sets Utf8Key to ''
  //In Utf8KeyPress do this only for Utf8 sequences, otherwise KeyPress is never called
  //because after this Utf8Key = ''
  if (Length(Utf8Key) > 1) then HandleKeyPress(Utf8Key);
end;


//Moved form LMMButtonUp message handler
procedure TCustomMaskEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if IsMasked then
  begin
    FCharPos := GetSelStart + 1;
    if not HasSelection then SetCursorPos;
  end;
end;

procedure TCustomMaskEdit.CheckCursor;
begin
  if IsMasked then
    SetCursorPos;
end;

procedure TCustomMaskEdit.CutToClipBoard;
begin
  if not IsMasked then
  begin
    inherited CutToClipBoard;
    Exit;
  end;
  CopyToClipBoard;
  DeleteSelected;
end;

procedure TCustomMaskEdit.PasteFromClipBoard;
{
  Paste only allowed chars, skip literals in the mask
  e.g. if cliptext = '1234' and mask = '00:00' then result will be '12:34'
}
var
  ClipText, S: String;
  P, i: LongInt;
  CP: TUTF8Char;
begin
  if not IsMasked then
  begin
    inherited PasteFromClipBoard;
    Exit;
  end;
 if Clipboard.HasFormat(CF_TEXT) then
 begin
   //debugln('TCustomMaskEdit.PasteFromClipBoard A');
   ClipText := ClipBoard.AsText;
   if (Utf8Length(ClipText) > 0) then
   begin
     P := FCharPos;
     DeleteSelected;
     S := inherited RealGetText;
     i := 1;
     //debugln('TCustomMaskEdit.PasteFromClipBoard B:');
     //debugln('  P = ',dbgs(p));
     //debugln('  S = ',s);
     //debugln('  ClipText = ',ClipText);
     while (P <= FMaskLength) and (i <= Utf8Length(ClipText)) do
     begin
       //Skip any literal
       while (P < FMaskLength) and (IsLiteral(P)) do Inc(P);
       //debugln('TCustomMaskEdit.PasteFromClipBoard C: P = ',DbgS(p));
       //Skip any char in ClipText that cannot be inserted at current position
       CP := GetCodePoint(ClipText,i);
       //Replace all control characters with spaces
       if (Length(CP) = 1) and (CP[1] in [#0..#31]) then CP := #32;
       while (i < Utf8Length(ClipText)) and (not CanInsertChar(P, CP, True)) do
       begin
         Inc(i);
         CP := GetCodePoint(ClipText,i);
       end;
       if CanInsertChar(P, CP, True) then
       begin
         SetCodePoint(S,P,CP);
         Inc(P);
         Inc(i);
       end
       else
         Break;
     end;
     RealSetTextWhileMasked(S);
     SetCursorPos;
   end;
 end;
end;


// Clear the controll
procedure TCustomMaskEdit.Clear;
Var
  S : ShortString;
  I : Integer;
begin
  if IsMasked then
  begin
    S  := '';
    for I := 1 To FMaskLength do S := S + ClearChar(I);
    RealSetTextWhileMasked(S);
    FCharPos := 1;
    SetCursorPos;
  end
  else Inherited Clear;
end;

procedure TCustomMaskEdit.SelectAll;
var
  S: String;
begin
  if IsMasked then
  begin
    S := inherited RealGetText;
    if (S <> '') then
    begin
      SetSelStart(0);
      SetSelLength(UTF8Length(S));
    end;
  end
  else
    inherited SelectAll;
end;

procedure TCustomMaskEdit.ValidateEdit;
var
  S: String;
begin
  //Only validate if IsMasked
  if IsMasked then
  begin
    S := inherited RealGetText;
    if not TextIsValid(S) then
    begin
      SetCursorPos;
      FValidationFailed := True;
      case FValidationErrorMode of
        mvemException: Raise EDBEditError.Create(SMaskEditNoMatch);
        mvemEvent: DoValidationError;
      end;
    end;
  end;
end;


{ Component registration procedure }
procedure Register;
begin
  RegisterComponents('Additional',[TMaskEdit]);
end;

initialization
  InitcMaskToMaskedTypeTable;

end.