unit Unit1;

 interface

 uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls,
IniFiles;//TStringHash使用 type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; type
// 边信息基类接口
IClassInfo = interface
['{219E2CE1-78AE-4479-A4D8-A23DB421621C}']
function GetName: string;
end;
//
TInfoClass = class of TMyClass;
//自定义的类
TMyClass = class(TObject, IInterface)
protected
FRefCount: Integer;
private
FMyName: string;
public
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
constructor Create; virtual;
function GetName: string; virtual;
property RefCount: Integer read FRefCount;
end;
//展示类
TMyClass1 = class(TMyClass, IClassInfo)
private
FMyName: string;
public
constructor Create; override;
function GetName: string; override;
end;
//工厂类
TClassInfoFactroy = class
class function CreateClass(const ATypeID: Integer): TMyClass;
end; var
Form1: TForm1; implementation {$R *.dfm} var
MyClassList: TStringHash; { TMyClass }
//注册类方法
procedure RegisterMyClass(const ATypeID: Integer; AClass: TInfoClass);
var
num: Integer;
begin
num := MyClassList.ValueOf(IntToStr(ATypeID));
if num = - then
MyClassList.Add(IntToStr(ATypeID), Integer(AClass))
else
Assert(False, Format('ElementTypeID %d ''s EdgeInfo already registered', [ATypeID]));
end; constructor TMyClass.Create;
begin
// 子类实现
end; function TMyClass.GetName: string;
begin
// 子类实现
end; function TMyClass.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result :=
else Result := E_NOINTERFACE;
end; function TMyClass._AddRef: Integer;
begin
Result := InterlockedIncrement(FRefCount);
end; function TMyClass._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = then Destroy;
end; { TMyClass1 } constructor TMyClass1.Create;
begin
FMyName := '类1';
end; function TMyClass1.GetName: string;
begin
Result := FMyName;
end; { TClassInfoFactroy }
//建立类方法
class function TClassInfoFactroy.CreateClass(const ATypeID: Integer): TMyClass;
var
nClass: Integer;
begin
nClass := MyClassList.ValueOf(IntToStr(ATypeID));
if nClass <> - then
Result := TInfoClass(nClass).Create
else begin
Result := nil;
end;
end;
//调用类方法
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := (TClassInfoFactroy.CreateClass() as IClassInfo).GetName;
end;
//初始化
initialization
if MyClassList = nil then
MyClassList:= TStringHash.Create();
// 注册类
RegisterMyClass(, TMyClass1); end.

Delphi使用TStringHash实现建立类(有点像反射)的更多相关文章

  1. php 建立类POST/GET 的HTTP请求

    1.第一种利用fsock的方式来建立类POST的请求. <?php $srv_ip = '192.168.1.5';//你的目标服务地址. $srv_port = 80;//端口 $url = ...

  2. Delphi之TStrings和TStringLists类

    Delphi之TStrings和TStringLists类 有些类不是组件,但它们支持存在的组件.这些类是其他组件的典型属性,直接由TPersistent派生,如TStrings.TCanvas和TC ...

  3. delphi 控制音量 静音的类

    delphi 控制音量 静音的类 unit ttSound; interface uses winapi.windows, winapi.Messages; type SimpleSoundContr ...

  4. Delphi 跨单元进入(访问)类的私有成员,protected ,private部分

    http://blog.sina.com.cn/s/blog_5f8861b60102v1nl.html Delphi 跨单元进入(访问)类的私有成员,protected ,private部分 (20 ...

  5. C# 直接创建多个类和使用反射创建类的性能

    原文:C# 直接创建多个类和使用反射创建类的性能 本文告诉大家我对比的使用直接创建多个类和使用反射创建多个类的性能 在上一篇 C# 程序内的类数量对程序启动的影响 的基础上,继续做实验 现在创建 10 ...

  6. 2019-11-29-C#-直接创建多个类和使用反射创建类的性能

    原文:2019-11-29-C#-直接创建多个类和使用反射创建类的性能 title author date CreateTime categories C# 直接创建多个类和使用反射创建类的性能 li ...

  7. 2019-8-31-C#-直接创建多个类和使用反射创建类的性能

    title author date CreateTime categories C# 直接创建多个类和使用反射创建类的性能 lindexi 2019-08-31 16:55:58 +0800 2018 ...

  8. 044-PHP获得多个类对应的反射信息

    <?php //获得多个类对应的反射信息 class demo{ public $str_1; private $str_2; protected $str_3; public function ...

  9. 043-PHP简单获得一个类对应的反射信息

    <?php // 简单获得一个类对应的反射信息 class demo{ CONST CON_STR = '123456'; public $str_1; private $str_2; prot ...

随机推荐

  1. POJ 2065 SETI(高斯消元)

    题目链接:http://poj.org/problem?id=2065 题意:给出一个字符串S[1,n],字母a-z代表1到26,*代表0.我们用数组C[i]表示S[i]经过该变换得到的数字.给出一个 ...

  2. Regex Failure - Bug Fixing #2

    http://www.codewars.com/kata/55c423ecf847fbcba100002b/train/csharp Oh no, Timmy's received some hate ...

  3. HDU 1698 Just a Hook (线段树 成段更新 lazy-tag思想)

    题目链接 题意: n个挂钩,q次询问,每个挂钩可能的值为1 2 3,  初始值为1,每次询问 把从x到Y区间内的值改变为z.求最后的总的值. 分析:用val记录这一个区间的值,val == -1表示这 ...

  4. Lost connection to MySQL server at 'reading initial communication packet' 错误解决

    Lost connection to MySQL server at 'reading initial communication packet' 错误解决 上次解决了这个问题,今天又碰到,突然失忆, ...

  5. 监听某个div或其它标签的大小改变来执行相应的处理

    jquery 默认的resize只能监听到浏览器窗口大小的改变,但我们在实际使用过程中有可能还需要监听某个div或其它标签的大小改变来执行相应的处理,如果使用默认的resize就无能为力了.怎么办呢, ...

  6. Nginx - 指定log_format,常用于 Awstats 分析

    1. vim /etc/nginx/nginx.conf (下面格式, Awstats 使用) log_format new_log '$remote_addr - $remote_user [$ti ...

  7. H264中的SPS、PPS提取与作用

    牛逼的视频会议网站:http://wmnmtm.blog.163.com/blog/#m=0 ++++++++++++++++++++++++++++++++++++++++++++++++++++ ...

  8. VS2010下编译安装DarwinStreamingServer5.5.5

    源码下载链接:http://dss.macosforge.org/源码版本: 5.5.5版本电脑环境:visual studio2010,window 7 x64系统.用VS2010打开WinNTSu ...

  9. SharePoint 2013让页面显示错误

    转:http://blog.csdn.net/zmoneyz/article/details/20460263 1. 在网站端口下,如80端口下的Web.config修改 (1)将<custom ...

  10. POJ 3067 Japan

    Japan Time Limit: 1000MS   Memory Limit: 65536K Total Submissions: 25489   Accepted: 6907 Descriptio ...