delphi應用GetClass與RegisterClass的例子

利用GetClass與RegisterClass可以實現根據字串來執行個體化具體的子類，這對於某些需 要動態配置程式的場合是很有用的。其他的應用如子表單切換，演算法替換等都能得到應用。

unit Example1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, StdCtrls;
type
　TForm1 = class(TForm)
　　Button1: TButton;
　　procedure Button1Click(Sender: TObject);
　private
　public
　end;
　ILog = interface(IUnknown)
　　['{A65044FC-644C-482A-BBFF-50A618835FC6}']
　　procedure WriteMessage;
　end;
　TLog = class(TInterfacedPersistent, ILog)
　public
　　class function CreateInstance(Name: string): TLog; overload;
　　procedure WriteMessage; virtual; abstract;
　end;
　TTextLog = class(TLog)
　public
　　procedure WriteMessage; override;
　end;
　TXMLLog = class(TLog)
　public
　　procedure WriteMessage; override;
　end;
　TNullLog = class(TLog)
　public
　　procedure WriteMessage; override;
　end;
var
　Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
　Log: TLog;
begin
　{ 實際應用中可以從配置中讀取字串來決定執行個體化具體的子類 }
　Log := TLog.CreateInstance('TXMLLog');
　if Assigned(Log) then
　begin
　　Log.WriteMessage;
　　Log.Free;
　end;
end;
class function TLog.CreateInstance(Name: string): TLog;
var
　AClass: TPersistentClass;
begin
　Result := nil;
　AClass := GetClass(Name);
　if Assigned(AClass) then
　begin
　　Result := AClass.NewInstance as TLog;
　　Result.Create;
　end
　else
　　{ error handle }
end;
{ TTextLog }
procedure TTextLog.WriteMessage;
begin
　//寫入到文字檔
end;
{ TXMLLog }
procedure TXMLLog.WriteMessage;
begin
　//寫入到XML檔案
end;
{ TNullLog }
procedure TNullLog.WriteMessage;
begin
　{ nothing need to do }
end;
initialization
　RegisterClass(TTextLog);
　RegisterClass(TXMLLog);
　RegisterClass(TNullLog);
finalization
　UnRegisterClass(TTextLog);
　UnRegisterClass(TXMLLog);
　UnRegisterClass(TNullLog);
end.