Come collegare gerarchia di classe “parallelo”?
-
20-08-2019 - |
Domanda
Ho una gerarchia di classi po 'dove ogni classe corrisponde ad un certo discendente TComponent (dire classe base TDefaultFrobber con discendenti TActionFrobber e TMenuItemFrobber, corrispondenti a TComponent, TCustomAction e TMENUITEM, rispettivamente). Ora voglio una fabbrica funzione di qualcosa di simile (?):
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;
Posso in qualche modo refactoring questa opzione per utilizzare le funzioni virtuali o qualcosa di simile, invece di if-else cascata o RTTI?
Modifica La mia soluzione per ora:
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.
Grazie a Cesar, Gamecat e mghie.
Soluzione
2 suggerimenti: Fai la classe di due serie di classi, allora si può ottenere l'indice e utilizzare la coppia di costruttore della classe,
var
ArrayItem: array[0..1] of TComponentClass = (TActionFrobber, TMenuItemFrobber);
ArrayOwner: array[0..1] of TComponentClass = (TCustomAction, TMenuItem);
function CreateFrobber(AComponent: TComponentClass): IFrobber;
var
Index: Integer;
begin
Result:= nil;
for I := Low(ArrayOwner) to High(ArrayOwner) do
if AComponent is ArrayOwner[I] then
begin
Result:= ArrayItem[I].Create(AComponent);
Break;
end;
if Result = nil then
Result:= TDefaultFrobber.Create(AComponent);
end;
o utilizzare le convenzioni RTTI + NomeClasse, come questo:
function CreateFrobber(AComponent: TComponentClass): IFrobber;
const
FrobberClassSuffix = 'Frobber';
var
LClass: TComponentClass;
LComponent: TComponent;
begin
LClass:= Classes.FindClass(AComponent.ClassName + FrobberClassSuffix);
if LClass <> nil then
LComponent:= LClass.Create(AComponent)
else
LComponent:= TDefaultFrobber.Create(AComponent);
if not Supports(LComponent, IFrobber, Result) then
Result:= nil;
end;
Altri suggerimenti
Se si crea una classe con un costruttore virtuale e di creare un tipo di classe per quella classe. È possibile creare un lookuplist in base al nome della classe del componente.
Esempio:
type
TFrobber = class
public
constructor Create; virtual;
class function CreateFrobber(const AComponent: TComponent): TFrobber;
end;
TFrobberClass = class of TFrobber;
type
TFrobberRec = record
ClassName: ShortString;
ClassType: TFrobberClass;
end;
const
cFrobberCount = 3;
cFrobberList : array[1..cFrobberCount] of TFrobberRec = (
(ClassName : 'TAction'; ClassType: TActionFrobber),
(ClassName : 'TButton'; ClassType: TButtonFrobber),
(ClassName : 'TMenuItem'; ClassType: TMenuItemFrobber)
);
class function TFrobber.CreateFrobber(const AComponent: TComponent): TFrobber;
var
i : Integer;
begin
Result := nil;
for i := 1 to cFrobberCount do begin
if AComponent.ClassName = cFrobberList[i].ClassName then begin
Result := cFrobberList[i].ClassType.Create();
Exit;
end;
end;
end;
Ovviamente si può lavorare anche con un elenco dinamico (dizionario), ma poi è necessario registrare ogni combinazione in qualche modo.
Aggiorna
Per commnent sulle osservazioni di mghie.
Hai perfettamente ragione. Ma questo non è forse senza veramente brutti trucchi. In questo momento è necessario utilizzare le inizializzazione / sezioni finalizzazione di un'unità per regoister una classe. Ma sarebbe bello aggiungere un metodo della classe di inizializzazione / finalizzazione ad una classe. Questi devono essere chiamato insieme con l'inizializzazione (e finalizzazione) dell'unità. In questo modo:
class
TFrobber = class
private
initialization Init; // Called at program start just after unit initialization
finalization Exit; // called at program end just before unit finalization.
end;
Mi piacerebbe aggiungere alcuni commenti alla soluzione attuale, rispondendo qui come questo non può davvero essere fatto nella sezione commenti:
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;
Non c'è molto punto nel usando TInterfacedObject per la classe di base, in quanto sarà sempre bisogno l'oggetto, non è l'interfaccia che implementa - in quale altro modo si dovrebbe trovare la vostra classe Frobber concreta? Voglio dividere questo in TComponentFrobber, scendendo da TInterfacedObject, e una classe TComponentRegistry (discendente da TObject) che ha i metodi della classe. È possibile poi, naturalmente, rendere la classe Registro di sistema più generica, che non è legato a TComponentFrobber e potrebbe essere riutilizzato.
Modifica Ho usato i registri di classe simili, ad esempio durante il caricamento di file: caricare l'identificatore per l'oggetto successivo (potrebbe essere ad esempio stringa, intero o il GUID), quindi ottenere la classe corretta per istanziare dal registro di sistema, quindi creare e caricare l'oggetto.
type
TComponentFrobberRegistryItem = record
ComponentClass: TComponentClass;
FrobberClass: TComponentFrobberClass;
end;
var
FComponentFrobberRegistry: array of TComponentFrobberRegistryItem;
Questa è OK se non si sarà mai aggiungere o rimuovere le classi da / per il Registro di sistema, ma in generale non vorrei usare una matrice, ma una lista per le voci di registro.
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;
Ricerca all'indietro nella matrice non aiuterà per trovare la frobber più specializzata, a meno che non li aggiunge nell'ordine corretto (almeno specializzato prima). Perché non controlli per la ClassType parità? C'è anche ClassParent per attraversare la gerarchia delle classi, se avete bisogno di test per le classi di base troppo.