I've got a little class hierarchy where each class corresponds to a certain TComponent descendent (say base class TDefaultFrobber with descendents TActionFrobber and TMenuItemFrobber, corresponding to TComponent, TCustomAction and TMenuItem, respectively). Now I want a factory (?) function something like this:
function CreateFrobber(AComponent: TComponent): IFrobber;
begin
if AComponent is TCustomAction then
Result := TActionFrobber.Create(TCustomAction(AComponent))
else if AComponent is TMenuItem then
Result := TMenuItemFrobber.Create(TMenuItem(AComponent))
else
Result := TDefaultFrobber.Create(AComponent);
end;
Can I somehow refactor this to use virtual functions or something similar instead of the if-else cascade or RTTI?
Edit: My solution for now:
unit Frobbers;
interface
uses
Classes;
type
IComponentFrobber = interface
end;
TComponentFrobberClass = class of TComponentFrobber;
TComponentFrobber = class(TInterfacedObject, IComponentFrobber)
strict private
FComponent: TComponent;
protected
constructor Create(AComponent: TComponent);
property Component: TComponent read FComponent;
public
class function FindFrobberClass(AComponentClass: TComponentClass): TComponentFrobberClass; overload; static;
class function FindFrobberClass(AComponent: TComponent): TComponentFrobberClass; overload; static;
class procedure RegisterFrobber(AComponentClass: TComponentClass; AFrobberClass: TComponentFrobberClass); static;
end;
implementation
uses
ActnList,
Menus;
type
TComponentFrobberRegistryItem = record
ComponentClass: TComponentClass;
FrobberClass: TComponentFrobberClass;
end;
var
FComponentFrobberRegistry: array of TComponentFrobberRegistryItem;
class function TComponentFrobber.FindFrobberClass(AComponentClass: TComponentClass): TComponentFrobberClass;
var
i: Integer;
begin
// Search backwards, so that more specialized frobbers are found first:
for i := High(FComponentFrobberRegistry) downto Low(FComponentFrobberRegistry) do
if FComponentFrobberRegistry[i].ComponentClass = AComponentClass then
begin
Result := FComponentFrobberRegistry[i].FrobberClass;
Exit;
end;
Result := nil;
end;
constructor TComponentFrobber.Create(AComponent: TComponent);
begin
inherited Create;
FComponent := AComponent;
end;
class function TComponentFrobber.FindFrobberClass(AComponent: TComponent): TComponentFrobberClass;
var
i: Integer;
begin
// Search backwards, so that more specialized frobbers are found first:
for i := High(FComponentFrobberRegistry) downto Low(FComponentFrobberRegistry) do
if AComponent is FComponentFrobberRegistry[i].ComponentClass then
begin
Result := FComponentFrobberRegistry[i].FrobberClass;
Exit;
end;
Result := nil;
end;
class procedure TComponentFrobber.RegisterFrobber(AComponentClass: TComponentClass;
AFrobberClass: TComponentFrobberClass);
var
i: Integer;
begin
Assert(FindFrobberClass(AComponentClass) = nil, 'Duplicate Frobber class');
i := Length(FComponentFrobberRegistry);
SetLength(FComponentFrobberRegistry, Succ(i));
FComponentFrobberRegistry[i].ComponentClass := AComponentClass;
FComponentFrobberRegistry[i].FrobberClass := AFrobberClass;
end;
function CreateComponentFrobber(AComponent: TComponent): IComponentFrobber;
var
FrobberClass: TComponentFrobberClass;
begin
FrobberClass := TComponentFrobber.FindFrobberClass(AComponent);
Assert(FrobberClass <> nil);
Result := FrobberClass.Create(AComponent);
end;
type
TActionFrobber = class(TComponentFrobber);
TMenuItemFrobber = class(TComponentFrobber);
initialization
TComponentFrobber.RegisterFrobber(TCustomAction, TActionFrobber);
TComponentFrobber.RegisterFrobber(TMenuItem, TMenuItemFrobber);
end.
Thanks to Cesar, Gamecat and mghie.