mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 09:37:56 +02:00
576 lines
16 KiB
ObjectPascal
576 lines
16 KiB
ObjectPascal
{ Copyright (C) 2005
|
|
|
|
*****************************************************************************
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
Author: Lagunov Aleksey
|
|
|
|
Abstract:
|
|
Property Editors for TMaskEdit.EditMask of FCL and LCL.
|
|
}
|
|
|
|
unit MaskPropEdit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
// LCL
|
|
Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ButtonPanel, MaskEdit,
|
|
// LazUtils
|
|
LazUTF8, LazFileUtils,
|
|
// IdeIntf
|
|
LazIDEIntf, PropEdits, ComponentEditors, ObjInspStrConsts, IDEWindowIntf, PropEditConfig;
|
|
|
|
type
|
|
|
|
{ TMaskEditorForm }
|
|
|
|
TMaskEditorForm = class(TForm)
|
|
private
|
|
type
|
|
TParsedSample = record
|
|
Caption, Example, FormattedExample, Mask: String;
|
|
end;
|
|
TParsedSamples = array of TParsedSample;
|
|
published
|
|
ButtonPanel1: TButtonPanel;
|
|
EnableSetsCheckBox: TCheckBox;
|
|
LoadSampleMasksButton: TButton;
|
|
UnloadSampleMasksButton: TButton;
|
|
SaveLiteralCheckBox: TCheckBox;
|
|
InputMaskEdit: TEdit;
|
|
CharactersForBlanksEdit: TEdit;
|
|
InputMaskLabel: TLabel;
|
|
SampleMasksLabel: TLabel;
|
|
CharactersForBlanksLabel: TLabel;
|
|
TestInputLabel: TLabel;
|
|
SampleMasksListBox: TListBox;
|
|
TestMaskEdit: TMaskEdit;
|
|
OpenDialog1: TOpenDialog;
|
|
TestInputPanel: TPanel;
|
|
procedure EnableSetsCheckBoxClick(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
|
|
procedure LoadSampleMasksButtonClick(Sender: TObject);
|
|
procedure UnloadSampleMasksButtonClick(Sender: TObject);
|
|
procedure SampleMasksListBoxDrawItem(Control: TWinControl; Index: Integer;
|
|
ARect: TRect; {%H-}State: TOwnerDrawState);
|
|
procedure SaveLiteralCheckBoxClick(Sender: TObject);
|
|
procedure InputMaskEditChange(Sender: TObject);
|
|
procedure CharactersForBlankEditChange(Sender: TObject);
|
|
procedure SampleMasksListBoxClick(Sender: TObject);
|
|
procedure MaskEditorFormCreate(Sender: TObject);
|
|
private
|
|
FEnableSets: Boolean;
|
|
ParsedSamples: TParsedSamples;
|
|
FSampleEditMaskFilename: String;
|
|
function ConstructEditmask: String;
|
|
function GetEditMask: string;
|
|
function MaskDoFormatText(const EditMask: string; const Value: string; EnableSets: Boolean): String;
|
|
function ParseMaskLineDelphi(Line: String; EnableSets: Boolean; out aCaption, aExample, aFormattedExample, aMask: String): Boolean;
|
|
function ParseMaskLineLazarus(Line: String; EnableSets: Boolean; out aCaption, aExample, aFormattedExample, aMask: String): Boolean;
|
|
procedure LoadAndCleanSampleFile(Fn: String; EnableSets: Boolean; List: TStrings; out AParsedSamples: TParsedSamples); //out list of record?
|
|
procedure ReConstructEditmask;
|
|
procedure SetEditMask(AValue: string);
|
|
procedure SetEnableSets(AValue: Boolean);
|
|
procedure UpdateTestEditor;
|
|
public
|
|
property EditMask: string read GetEditMask write SetEditMask;
|
|
property EnableSets: Boolean write SetEnableSets;
|
|
end;
|
|
|
|
{ TEditMaskProperty }
|
|
|
|
TEditMaskProperty = class(TStringPropertyEditor)
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure Edit; override;
|
|
function GetMaskEdit: TCustomMaskEdit;
|
|
end;
|
|
|
|
{ TMaskEditEditor }
|
|
TCustomMaskEditAccess = class(TCustomMaskEdit)
|
|
end; //Hack to get access to EditMask
|
|
|
|
TMaskEditEditor = class(TDefaultComponentEditor)
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
function MaskEdit: TCustomMaskEditAccess; virtual;
|
|
end;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
|
|
{ TMaskEditorForm }
|
|
|
|
procedure TMaskEditorForm.MaskEditorFormCreate(Sender: TObject);
|
|
begin
|
|
Caption := oisInputMaskEditor;
|
|
LoadSampleMasksButton.Caption := oisMasks;
|
|
UnloadSampleMasksButton.Caption := oisUnload;
|
|
UnloadSampleMasksButton.Hint := oisUnloadHint; // alternatively have a longer caption?
|
|
SaveLiteralCheckBox.Caption := oisSaveLiteralCharacters;
|
|
InputMaskLabel.Caption := oisInputMask;
|
|
SampleMasksLabel.Caption := oisSampleMasks;
|
|
CharactersForBlanksLabel.Caption := oisCharactersForBlanks;
|
|
TestInputLabel.Caption := oisTestInput;
|
|
|
|
EnableSetsCheckBox.Hint := oisEnableSetsHint;
|
|
OpenDialog1.Filter := oisMaskSampleFilter;
|
|
OpenDialog1.Title := oisSelectInputMaskSample;
|
|
|
|
if not Assigned(PropEditConfigs) then
|
|
PropEditConfigs := TPropEditConfigs.Create;
|
|
PropEditConfigs.Load;
|
|
FSampleEditMaskFilename := PropEditConfigs.SampleEditMaskFilename;
|
|
FSampleEditMaskFilename := CleanAndExpandFilename(FSampleEditMaskFilename);
|
|
if (FSampleEditMaskFilename <> '') and FileExistsUTF8(FSampleEditMaskFilename) then
|
|
LoadAndCleanSampleFile(FSampleEditMaskFilename, FEnableSets, SampleMasksListBox.Items, ParsedSamples);
|
|
IDEDialogLayoutList.ApplyLayout(Self);
|
|
end;
|
|
|
|
procedure TMaskEditorForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
begin
|
|
PropEditConfigs.SampleEditMaskFilename := FSampleEditMaskFilename;
|
|
PropEditConfigs.Save;
|
|
IDEDialogLayoutList.SaveLayout(Self);
|
|
end;
|
|
|
|
procedure TMaskEditorForm.UnloadSampleMasksButtonClick(Sender: TObject);
|
|
begin
|
|
SampleMasksListBox.Clear;
|
|
ParsedSamples := nil;
|
|
FSampleEditMaskFilename := '';
|
|
end;
|
|
|
|
procedure TMaskEditorForm.EnableSetsCheckBoxClick(Sender: TObject);
|
|
begin
|
|
SetEnableSets(EnableSetsCheckBox.Checked);
|
|
end;
|
|
|
|
procedure TMaskEditorForm.LoadSampleMasksButtonClick(Sender: TObject);
|
|
begin
|
|
OpenDialog1.InitialDir:=ExtractFileDir(FSampleEditMaskFilename);
|
|
if OpenDialog1.Execute then
|
|
LoadAndCleanSampleFile(OpenDialog1.Filename, FEnableSets, SampleMasksListBox.Items, ParsedSamples);
|
|
end;
|
|
|
|
procedure TMaskEditorForm.SampleMasksListBoxDrawItem(Control: TWinControl;
|
|
Index: Integer; ARect: TRect; State: TOwnerDrawState);
|
|
var
|
|
OldBrushStyle: TBrushStyle;
|
|
OldTextStyle: TTextStyle;
|
|
NewTextStyle: TTextStyle;
|
|
ListBox: TListBox absolute Control;
|
|
R1, R2: TRect;
|
|
begin
|
|
ListBox.Canvas.FillRect(ARect);
|
|
if (Index >= 0) and (Index < ListBox.Items.Count) then
|
|
begin
|
|
OldBrushStyle := ListBox.Canvas.Brush.Style;
|
|
ListBox.Canvas.Brush.Style := bsClear;
|
|
|
|
OldTextStyle := ListBox.Canvas.TextStyle;
|
|
NewTextStyle := OldTextStyle;
|
|
NewTextStyle.Layout := tlCenter;
|
|
ListBox.Canvas.TextStyle := NewTextStyle;
|
|
|
|
R1 := ARect;
|
|
R2 := ARect;
|
|
R1.Right := (R1.Left + R1.Right) div 2;
|
|
R2.Left := R1.Right + 1;
|
|
ListBox.Canvas.TextRect(R1, R1.Left + 2, R1.Top, ParsedSamples[Index].Caption);
|
|
ListBox.Canvas.TextRect(R2, R2.Left + 2, R2.Top, ParsedSamples[Index].FormattedExample);
|
|
ListBox.Canvas.MoveTo(R2.Left - 1, R2.Top);
|
|
ListBox.Canvas.LineTo(R2.Left - 1, R2.Bottom);
|
|
ListBox.Canvas.Brush.Style := OldBrushStyle;
|
|
ListBox.Canvas.TextStyle := OldTextStyle;
|
|
end;
|
|
end;
|
|
|
|
procedure TMaskEditorForm.SaveLiteralCheckBoxClick(Sender: TObject);
|
|
|
|
begin
|
|
ReconstructEditMask;
|
|
end;
|
|
|
|
procedure TMaskEditorForm.InputMaskEditChange(Sender: TObject);
|
|
begin
|
|
UpdateTestEditor;
|
|
end;
|
|
|
|
procedure TMaskEditorForm.CharactersForBlankEditChange(Sender: TObject);
|
|
var
|
|
S:string;
|
|
SL: Boolean;
|
|
BC: Char;
|
|
begin
|
|
SplitEditMask(InputMaskEdit.Text, S, SL, BC);
|
|
if (CharactersForBlanksEdit.Text<>'') and (Length(S) > 0) then
|
|
begin
|
|
BC := CharactersForBlanksEdit.Text[1];
|
|
if SL then InputMaskEdit.Text:=S + MaskFieldSeparator + '1' + MaskFieldSeparator + BC
|
|
else InputMaskEdit.Text:=S + MaskFieldSeparator + MaskNoSave + MaskFieldSeparator + BC;
|
|
end
|
|
else
|
|
ReConstructEditMask
|
|
end;
|
|
|
|
|
|
Function TMaskEditorForm.ConstructEditmask : String;
|
|
|
|
Var
|
|
S : String;
|
|
B : Char;
|
|
L : Boolean;
|
|
|
|
begin
|
|
SplitEditMask(InputMaskEdit.Text,S,L,B);
|
|
If (CharactersForBlanksEdit.Text<>'') then
|
|
B:=CharactersForBlanksEdit.Text[1];
|
|
if (Length(S) = 0) then
|
|
Result := ''
|
|
else
|
|
Result:=Format('%s'+MaskFieldSeparator+'%d'+MaskFieldSeparator+'%s',[S,ord(SaveLiteralCheckBox.checked),B]);
|
|
end;
|
|
|
|
procedure TMaskEditorForm.ReConstructEditmask;
|
|
|
|
begin
|
|
InputMaskEdit.Text:=ConstructEditMask;
|
|
UpdateTestEditor;
|
|
end;
|
|
|
|
procedure TMaskEditorForm.SampleMasksListBoxClick(Sender: TObject);
|
|
begin
|
|
if (SampleMasksListBox.Items.Count > 0) then
|
|
begin
|
|
TestMaskEdit.Text := '';
|
|
EditMask := ParsedSamples[SampleMasksListBox.ItemIndex].Mask;
|
|
end;
|
|
end;
|
|
|
|
function TMaskEditorForm.GetEditMask: string;
|
|
begin
|
|
Result:=ConstructEditMask;
|
|
end;
|
|
|
|
function TMaskEditorForm.MaskDoFormatText(const EditMask: string; const Value: string; EnableSets: Boolean): String;
|
|
var
|
|
P: Integer;
|
|
S, MaskPart: String;
|
|
MaskSave: Boolean;
|
|
SpaceChar: Char;
|
|
begin
|
|
// cheat maskutils while it has no its own MaskDoFormatText
|
|
SplitEditMask(EditMask, MaskPart, MaskSave, SpaceChar);
|
|
// in order to construct the displayed string from the "example text" field,
|
|
// we must set MaskSave to False and SpaceChar to #32, otherwise the result
|
|
// won't be the same as in Delphi
|
|
S := MaskPart+';0; ';
|
|
try
|
|
Result := FormatMaskText(S, Value, EnableSets);
|
|
except
|
|
Result := Value;
|
|
end;
|
|
end;
|
|
|
|
function TMaskEditorForm.ParseMaskLineDelphi(Line: String; EnableSets: Boolean; out aCaption, aExample, aFormattedExample, aMask: String): Boolean;
|
|
var
|
|
P1, P2: SizeInt;
|
|
begin
|
|
{
|
|
in delphi .dem files every line is made up like this:
|
|
|
|
Maskname
|
|
zero or more spaces
|
|
a pipe symbol (|)
|
|
one space
|
|
Example Text
|
|
one space
|
|
a pipe symbol (|)
|
|
one space
|
|
Editmask
|
|
zero or more spaces
|
|
|
|
Trailing spaces from Maskname will be stripped
|
|
The first and last character from the Example Text field will be stripped away (hence they should be spaces)
|
|
The first character from the Editmask field will be stripped away, as well as trailing spaces
|
|
So notice that except for 2 places, whitespace is significant.
|
|
}
|
|
|
|
Result := False;
|
|
//we need at least 2 | symbols
|
|
P1 := Pos('|', Line);
|
|
if (P1 = 0) then
|
|
Exit;
|
|
P2 := Pos('|', Line, P1 + 1);
|
|
if (P2 = 0) then
|
|
Exit;
|
|
aCaption := TrimRight(Copy(Line, 1, P1-1));
|
|
if (aCaption = '') then
|
|
Exit;
|
|
aExample := (Copy(Line, P1+2, P2-P1-3));
|
|
if (aExample = '') then
|
|
Exit;
|
|
aMask := TrimRight(Copy(Line,P2+2,MaxInt));
|
|
if (aMask = '') then
|
|
Exit;
|
|
aFormattedExample := MaskDoFormatText(aMask, aExample, EnableSets);
|
|
Result := True;
|
|
end;
|
|
|
|
function TMaskEditorForm.ParseMaskLineLazarus(Line: String; EnableSets: Boolean; out aCaption, aExample, aFormattedExample, aMask: String): Boolean;
|
|
var
|
|
P1, P2: SizeInt;
|
|
begin
|
|
{
|
|
in Lazarus .lem files every line is made up like this:
|
|
|
|
Maskname
|
|
zero or more spaces
|
|
a pipe symbol (|)
|
|
zero or more spaces
|
|
Example Text
|
|
zero or more spaces
|
|
a pipe symbol (|)
|
|
zero or more spaces
|
|
Editmask
|
|
zero or more spaces
|
|
|
|
Trailing spaces from Maskname will be stripped
|
|
Leading and trailing spaces from Example Text and EditMask will be stripped.
|
|
|
|
Lines starting with '//' will be ignored
|
|
}
|
|
|
|
Result := False;
|
|
if (TrimLeft(Line).StartsWith('//')) then
|
|
Exit;
|
|
//we need at least 2 | symbols
|
|
P1 := Pos('|', Line);
|
|
if (P1 = 0) then
|
|
Exit;
|
|
P2 := Pos('|', Line, P1 + 1);
|
|
if (P2 = 0) then
|
|
Exit;
|
|
aCaption := TrimRight(Copy(Line, 1, P1-1));
|
|
if (aCaption = '') then
|
|
Exit;
|
|
aExample := Trim(Copy(Line, P1+1, P2-P1-1));
|
|
if (aExample = '') then
|
|
Exit;
|
|
aMask := Trim(Copy(Line,P2+1,MaxInt));
|
|
if (aMask = '') then
|
|
Exit;
|
|
aFormattedExample := MaskDoFormatText(aMask, aExample, EnableSets);
|
|
Result := True;
|
|
end;
|
|
|
|
|
|
procedure TMaskEditorForm.LoadAndCleanSampleFile(Fn: String; EnableSets: Boolean; List: TStrings; out AParsedSamples: TParsedSamples);
|
|
type
|
|
TParseFunc = function (Line: String; EnableSets: Boolean; out Caption, Example, FormattedExample, Mask: String): Boolean of Object;
|
|
var
|
|
i, Index: Integer;
|
|
S, aCaption, aExample, aFormattedExample, aMask: String;
|
|
SL: TStringList;
|
|
ParseFunc: TParseFunc;
|
|
begin
|
|
FSampleEditMaskFilename := '';
|
|
AParsedSamples := nil;
|
|
if (CompareText(ExtractFileExt(Fn),'.dem') = 0) then
|
|
ParseFunc := @ParseMaskLineDelphi
|
|
else
|
|
ParseFunc := @ParseMaskLineLazarus;
|
|
List.BeginUpdate;
|
|
List.Clear;
|
|
if not FileExistsUtf8(Fn) then
|
|
Exit;
|
|
SL := TStringList.Create;
|
|
try
|
|
try
|
|
SL.LoadFromFile(Fn, TEncoding.UTF8);
|
|
SetLength(AParsedSamples, SL.Count);
|
|
Index := 0;
|
|
for i := 0 to SL.Count - 1 do
|
|
begin
|
|
S := SL[i];
|
|
if ParseFunc(S, EnableSets, aCaption, aExample, aFormattedExample, aMask) then
|
|
begin
|
|
AParsedSamples[Index].Caption := aCaption;
|
|
AParsedSamples[Index].Example := aExample;
|
|
AParsedSamples[Index].FormattedExample := aFormattedExample;
|
|
AParsedSamples[Index].Mask := aMask;
|
|
List.Add(S);
|
|
Inc(Index);
|
|
end;
|
|
end;
|
|
SetLength(AParsedSamples, Index);
|
|
FSampleEditMaskFilename := Fn;
|
|
except
|
|
on ESTreamError do
|
|
begin
|
|
List.Clear;
|
|
AParsedSamples := nil;
|
|
FSampleEditMaskFilename := '';
|
|
MessageDlg(Format(oisErrorReadingSampleFile,[Fn]), mtError, [mbOk], 0);
|
|
end;
|
|
end;
|
|
finally
|
|
List.EndUpdate;
|
|
SL.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMaskEditorForm.SetEditMask(AValue: string);
|
|
|
|
Var
|
|
M : String;
|
|
B : Char;
|
|
S : Boolean;
|
|
|
|
begin
|
|
SplitEditMask(AValue,M,S,B);
|
|
InputMaskEdit.Text := AValue;
|
|
SaveLiteralCheckBox.Checked := S;
|
|
CharactersForBlanksEdit.Text := B;
|
|
UpdateTestEditor;
|
|
end;
|
|
|
|
procedure TMaskEditorForm.SetEnableSets(AValue: Boolean);
|
|
var
|
|
OldMask: String;
|
|
WasMasked: Boolean;
|
|
i: Integer;
|
|
begin
|
|
FEnableSets := AValue;
|
|
WasMasked := TestMaskEdit.IsMasked;
|
|
if WasMasked then
|
|
begin
|
|
OldMask := TestMaskEdit.EditMask;
|
|
TestMaskEdit.EditMask := '';
|
|
end;
|
|
TestMaskEdit.EnableSets := FEnableSets;
|
|
if WasMasked then
|
|
begin
|
|
TestMaskEdit.EditMask := OldMask;
|
|
end;
|
|
//since this is not only called from clicking on the checkbox
|
|
EnableSetsCheckBox.Checked := FEnableSets;
|
|
for i := 0 to Length(ParsedSamples) - 1 do
|
|
begin
|
|
ParsedSamples[i].FormattedExample := MaskDoFormatText(ParsedSamples[i].Mask, ParsedSamples[i].Example, FEnableSets);
|
|
end;
|
|
SampleMasksListBox.Invalidate;
|
|
//since this is not only called from clicking on the checkbox
|
|
EnableSetsCheckBox.Checked := FEnableSets;
|
|
end;
|
|
|
|
procedure TMaskEditorForm.UpdateTestEditor;
|
|
begin
|
|
TestMaskEdit.EditMask:=InputMaskEdit.Text;
|
|
end;
|
|
|
|
{ TEditMaskProperty }
|
|
|
|
function TEditMaskProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result:= [paDialog, paMultiSelect, paRevertable];
|
|
end;
|
|
|
|
procedure TEditMaskProperty.Edit;
|
|
var
|
|
MaskEditorForm: TMaskEditorForm;
|
|
C: TPersistent;
|
|
AMaskEdit: TCustomMaskEdit;
|
|
begin
|
|
MaskEditorForm:=TMaskEditorForm.Create(Application);
|
|
try
|
|
AMaskEdit := GetMaskEdit;
|
|
MaskEditorForm.EnableSets := AMaskEdit.EnableSets;
|
|
MaskEditorForm.EditMask:=GetValue;
|
|
if MaskEditorForm.ShowModal = mrOk then
|
|
SetValue(MaskEditorForm.EditMask);
|
|
finally
|
|
MaskEditorForm.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TEditMaskProperty.GetMaskEdit: TCustomMaskEdit;
|
|
var
|
|
i: Integer;
|
|
C: TPersistent;
|
|
begin
|
|
Result := nil;
|
|
for i:=0 to PropCount-1 do
|
|
begin
|
|
C := GetComponent(i);
|
|
if C is TCustomMaskEdit then
|
|
begin
|
|
Result := TCustomMaskEdit(C);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TMaskEditEditor }
|
|
|
|
procedure TMaskEditEditor.ExecuteVerb(Index: Integer);
|
|
var
|
|
MaskEditorForm: TMaskEditorForm;
|
|
begin
|
|
if Index = 0 then
|
|
begin
|
|
MaskEditorForm := TMaskEditorForm.Create(Application);
|
|
try
|
|
MaskEditorForm.EnableSets := MaskEdit.EnableSets;
|
|
MaskEditorForm.EditMask := MaskEdit.EditMask;
|
|
if MaskEditorForm.ShowModal = mrOk then
|
|
MaskEdit.EditMask := MaskEditorForm.EditMask;
|
|
finally
|
|
MaskEditorForm.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TMaskEditEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
case Index of
|
|
0: Result := sccsMaskEditor;
|
|
else
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
function TMaskEditEditor.GetVerbCount: Integer;
|
|
begin
|
|
Result := 1;
|
|
end;
|
|
|
|
function TMaskEditEditor.MaskEdit: TCustomMaskEditAccess;
|
|
begin
|
|
Result := TCustomMaskEditAccess(GetComponent)
|
|
end;
|
|
|
|
initialization
|
|
RegisterPropertyEditor(TypeInfo(string), TCustomMaskEdit, 'EditMask',
|
|
TEditMaskProperty);
|
|
RegisterComponentEditor(TMaskEdit, TMaskEditEditor);
|
|
|
|
end.
|
|
|