LMS-2_ReportAPI/commandcol.pas
Алексей Заблоцкий 885d006de3 LMSTWO-1
2023-11-07 20:52:31 +03:00

68 lines
1.7 KiB
ObjectPascal

unit commandcol;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils,Contnrs,baseconnection;
type
{ TCommandCollection }
TCommandCollection=Class;
TCommandCollection=Class(TClassList)
private
class var fCollection: TCommandCollection;
public
class procedure Register(ACommand: TCommandClass);
class function Find(Action,SubClass: string): TCommandClass;
class procedure Init;
class procedure Done;
end;
implementation
{ TCommandCollection }
class procedure TCommandCollection.Register(ACommand: TCommandClass);
begin
if not assigned(fCollection) then
Init;
fCollection.Add(ACommand);
end;
class function TCommandCollection.Find(Action, SubClass: string): TCommandClass;
var
i: integer;
begin
for i := 0 to fCollection.Count-1 do
if fCollection.Items[i].InheritsFrom(TCommand) and SameText(Action, TCommandClass(fCollection.Items[i]).CommandName) and SameText(SubClass, TCommandClass(fCollection.Items[i]).CommandSubClass) then
begin
result := TCommandClass(fCollection.Items[i]) ;
exit;
end;
for i := 0 to fCollection.Count-1 do
if fCollection.Items[i].InheritsFrom(TCommand) and SameText(Action, TCommandClass(fCollection.Items[i]).CommandName) and SameText('', TCommandClass(fCollection.Items[i]).CommandSubClass) then
begin
result := TCommandClass(fCollection.Items[i]) ;
exit;
end;
result := nil;
end;
class procedure TCommandCollection.Init;
begin
if not assigned(fCollection) then
fCollection := TCommandCollection.Create;
end;
class procedure TCommandCollection.Done;
begin
fCollection.Free;
end;
initialization
TCommandCollection.Init;
finalization
TCommandCollection.Done;
end.