paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 17:30:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: Masks: implement TMaskList.Mask property.

Browse Source
This commit is contained in:
Bart 2021-10-31 19:41:00 +01:00
parent 1543c68c73
commit 1a0f808921
1 changed files with 31 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
components/lazutils/masks.pas
View File

@ -229,8 +229,9 @@ type
procedure AddLiteral; procedure AddLiteral;
procedure AddRange(lFirstRange, lSecondRange: Integer); procedure AddRange(lFirstRange, lSecondRange: Integer);
procedure CompileRange; procedure CompileRange;
function GetMask: String; virtual;
procedure ReverseRange(lFirstRange, lSecondRange: Integer); procedure ReverseRange(lFirstRange, lSecondRange: Integer);
procedure SetOriginalMask(AValue: String); procedure SetMask(AValue: String); virtual;
protected protected
fOriginalMask: String; fOriginalMask: String;
class function CompareUTF8Sequences(const P1,P2: PChar): integer; static; class function CompareUTF8Sequences(const P1,P2: PChar): integer; static;
@ -247,7 +248,7 @@ type
function MatchesWindowsMask(const AFileName: String): Boolean; function MatchesWindowsMask(const AFileName: String): Boolean;
deprecated 'Create with TMaskWindows.Create, then call Matches.'; // in Lazarus 2.3, remove in 2.5. deprecated 'Create with TMaskWindows.Create, then call Matches.'; // in Lazarus 2.3, remove in 2.5.
public public
property Mask: String read fOriginalMask write SetOriginalMask; property Mask: String read GetMask write SetMask;
end; end;
TMask = class(TMaskUTF8); TMask = class(TMaskUTF8);
@ -256,7 +257,8 @@ type
TWindowsMaskUTF8=class(TMask) TWindowsMaskUTF8=class(TMask)
private private
procedure SetWindowsMask(AValue: String); procedure SetMask(AValue: String); override;
function GetMask: String; override;
procedure SetWindowsQuirkAllowed(AValue: TWindowsQuirks); procedure SetWindowsQuirkAllowed(AValue: TWindowsQuirks);
protected protected
fWindowsQuirkAllowed: TWindowsQuirks; fWindowsQuirkAllowed: TWindowsQuirks;
@ -271,7 +273,6 @@ type
procedure Compile; override; procedure Compile; override;
function Matches(const aFileName: String): Boolean; override; function Matches(const aFileName: String): Boolean; override;
public public
property Mask: String read fWindowsMask write SetWindowsMask;
property Quirks: TWindowsQuirks read fWindowsQuirkAllowed write SetWindowsQuirkAllowed; property Quirks: TWindowsQuirks read fWindowsQuirkAllowed write SetWindowsQuirkAllowed;
end; end;
@ -300,6 +301,7 @@ type
//fWindowsMasks: TObjectList; // remove in 2.5 //fWindowsMasks: TObjectList; // remove in 2.5
function GetCount: Integer; function GetCount: Integer;
function GetItem(Index: Integer): TMask; function GetItem(Index: Integer): TMask;
procedure SetMask(AValue: String); virtual;
protected protected
function GetMaskClass: TMaskClass; virtual; function GetMaskClass: TMaskClass; virtual;
procedure AddMasksToList(const aValue: String; aSeparator: Char; CaseSensitive: Boolean; procedure AddMasksToList(const aValue: String; aSeparator: Char; CaseSensitive: Boolean;
@ -322,6 +324,7 @@ type
property Count: Integer read GetCount; property Count: Integer read GetCount;
property Items[Index: Integer]: TMask read GetItem; property Items[Index: Integer]: TMask read GetItem;
property Mask: String read fMask write SetMask;
end; end;
@ -707,7 +710,7 @@ begin
fMaskInd:=lSecondRange; fMaskInd:=lSecondRange;
end; end;
procedure TMaskUTF8.SetOriginalMask(AValue: String); procedure TMaskUTF8.SetMask(AValue: String);
begin begin
if fOriginalMask = AValue then Exit; if fOriginalMask = AValue then Exit;
fOriginalMask := AValue; fOriginalMask := AValue;
@ -844,6 +847,11 @@ begin
Exception_MissingCloseChar(']',fMaskLimit); Exception_MissingCloseChar(']',fMaskLimit);
end; end;
function TMaskUTF8.GetMask: String;
begin
Result := fOriginalMask;
end;
procedure TMaskUTF8.Compile; procedure TMaskUTF8.Compile;
begin begin
inherited Compile; inherited Compile;
@ -1148,11 +1156,16 @@ end;
{ TWindowsMask } { TWindowsMask }
procedure TWindowsMaskUTF8.SetWindowsMask(AValue: String); procedure TWindowsMaskUTF8.SetMask(AValue: String);
begin begin
if fWindowsMask = AValue then Exit; if (AValue = fWindowsMask) then Exit;
inherited SetMask(AValue);
fWindowsMask := AValue; fWindowsMask := AValue;
fMaskIsCompiled := False; end;
function TWindowsMaskUTF8.GetMask: String;
begin
Result := fWindowsMask;
end; end;
procedure TWindowsMaskUTF8.SetWindowsQuirkAllowed(AValue: TWindowsQuirks); procedure TWindowsMaskUTF8.SetWindowsQuirkAllowed(AValue: TWindowsQuirks);
@ -1382,6 +1395,16 @@ begin
Result := TMask(fMasks.Items[Index]); Result := TMask(fMasks.Items[Index]);
end; end;
procedure TMaskList.SetMask(AValue: String);
var
i: Integer;
begin
if fMask = AValue then Exit;
fMask := AValue;
for i := 0 to fMasks.Count - 1 do
TMask(fMasks.Items[i]).Mask := fMask;
end;
function TMaskList.GetMaskClass: TMaskClass; function TMaskList.GetMaskClass: TMaskClass;
begin begin
Result := TMask; Result := TMask;