1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, StdCtrls, jpeg, ExtCtrls,
  8   IniFiles;//TStringHash使用
  9 
 10 type
 11   TForm1 = class(TForm)
 12     Button1: TButton;
 13     Edit1: TEdit;
 14     Image1: TImage;
 15     procedure Button1Click(Sender: TObject);
 16   private
 17     { Private declarations }
 18   public
 19     { Public declarations }
 20   end;
 21 
 22 type
 23   // 边信息基类接口
 24   IClassInfo = interface
 25   ['{219E2CE1-78AE-4479-A4D8-A23DB421621C}']
 26     function GetName: string;
 27   end;
 28   //
 29   TInfoClass = class of TMyClass;
 30   //自定义的类
 31   TMyClass = class(TObject, IInterface)
 32   protected
 33     FRefCount: Integer;
 34   private
 35     FMyName: string;
 36   public
 37     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
 38     function _AddRef: Integer; stdcall;
 39     function _Release: Integer; stdcall;
 40     constructor Create; virtual;
 41     function GetName: string; virtual;
 42     property  RefCount: Integer read FRefCount;
 43   end;
 44   //展示类
 45   TMyClass1 = class(TMyClass, IClassInfo)
 46   private
 47     FMyName: string;
 48   public
 49     constructor Create; override;
 50     function GetName: string; override;
 51   end;
 52   //工厂类
 53   TClassInfoFactroy = class
 54     class function CreateClass(const ATypeID: Integer): TMyClass;
 55   end;
 56 
 57 var
 58   Form1: TForm1;
 59 
 60 implementation
 61 
 62 {$R *.dfm}
 63 
 64 var
 65   MyClassList: TStringHash;
 66 
 67 { TMyClass }
 68 //注册类方法
 69 procedure RegisterMyClass(const ATypeID: Integer; AClass: TInfoClass);
 70 var
 71   num: Integer;
 72 begin
 73    num := MyClassList.ValueOf(IntToStr(ATypeID));
 74    if num = -1  then
 75      MyClassList.Add(IntToStr(ATypeID), Integer(AClass))
 76    else
 77     Assert(False, Format('ElementTypeID %d ''s EdgeInfo already registered', [ATypeID]));
 78 end;
 79 
 80 constructor TMyClass.Create;
 81 begin
 82 // 子类实现
 83 end;
 84 
 85 function TMyClass.GetName: string;
 86 begin
 87 // 子类实现
 88 end;
 89 
 90 function TMyClass.QueryInterface(const IID: TGUID; out Obj): HResult;
 91 begin
 92   if GetInterface(IID, Obj) then
 93     Result := 0
 94   else Result := E_NOINTERFACE;
 95 end;
 96 
 97 function TMyClass._AddRef: Integer;
 98 begin
 99   Result := InterlockedIncrement(FRefCount);
100 end;
101 
102 function TMyClass._Release: Integer;
103 begin
104   Result := InterlockedDecrement(FRefCount);
105   if Result = 0 then Destroy;
106 end;
107 
108 { TMyClass1 }
109 
110 constructor TMyClass1.Create;
111 begin
112   FMyName := '类1';
113 end;
114 
115 function TMyClass1.GetName: string;
116 begin
117   Result := FMyName;
118 end;
119 
120 { TClassInfoFactroy }
121 //建立类方法
122 class function TClassInfoFactroy.CreateClass(const ATypeID: Integer): TMyClass;
123 var
124   nClass: Integer;
125 begin
126   nClass := MyClassList.ValueOf(IntToStr(ATypeID)); 
127   if nClass <> -1 then
128     Result := TInfoClass(nClass).Create
129   else begin
130     Result := nil;
131   end;
132 end;
133 //调用类方法
134 procedure TForm1.Button1Click(Sender: TObject);
135 begin
136   Edit1.Text := (TClassInfoFactroy.CreateClass(123) as IClassInfo).GetName;
137 end;
138 //初始化
139 initialization
140   if MyClassList = nil then
141     MyClassList:= TStringHash.Create(26);
142   // 注册类
143   RegisterMyClass(123, TMyClass1);
144 
145 end.