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.