一个灵巧的Delphi多播实事件现方案
一个灵巧的Delphi多播实现方案.必须是支持泛型的Delphi版本.也就是Delphi2009以后.强烈建议用DelphiXE.
用法就是例如写一个Class指定一个Event,触发的时候会通知多个Method.和.NET的多播事件机制是一样的.
用法例如:
type
TFakeButton = class(TButton)
private
FMultiCast_OnClik : TMulticastEvent<TNotifyEvent>;
public
constructor Create(AOwnder : TComponent);override;
destructor Destroy; override;
procedure Click; override;
property MultiCast_OnClik : TMulticastEvent<TNotifyEvent> read FMultiCast_OnClik;
end;
{ TTest }
procedure TFakeButton.Click;
begin
inherited;
//这样调用可以通知多个事件
FMultiCast_OnClik.Invok(Self);
end;
constructor TFakeButton.Create(AOwnder : TComponent);
begin
inherited Create(AOwnder);
FMultiCast_OnClik := TMulticastEvent<TNotifyEvent>.Create;
end;
destructor TFakeButton.Destroy;
begin
FMultiCast_OnClik.Free;
inherited Destroy;
end;
//
procedure TForm2.Button1Click(Sender: TObject);
var
Test : TFakeButton;
begin
Test := TFakeButton.Create(Self);
Test.MultiCast_OnClik.Add(TestA);
Test.MultiCast_OnClik.Add(TestB);
Test.SetBounds(0,0,100,100);
test.Caption := '试试多播';
Test.Parent := Self;
end;
procedure TForm2.TestA(Sender: TObject);
begin
ShowMessage(Caption);
end;
procedure TForm2.TestB(Sender: TObject);
begin
ShowMessage(FormatDateTime('yyyy-mm-dd hh:nn:ss',now));
end;
在按钮上点一下,直接会触发TestA,和TestB.
这个做法主要是省了写一个事件容器,然后循环调用的麻烦.
下面是方案的代码:
{
一个多播方法的实现.
和一位同事(一位Delphi牛人)一起讨论了一下Delphi下多播事件的实现.
他提供了一个易博龙技术牛人的多播事件方案.这个方案非常牛,但是依赖Delphi的
编译器特性太多,只能用在开启优化的代码.而DelphiXE默认Debug是关闭优化的.
重写了一个TMulticastEvent.这个不依赖Delphi的编译器产生的代码特性.
其中InternalInvoke基本上是那位易博龙大牛的代码.加了详细的注释
wr960204. 2011.5.28
}
unit MultiCastEventUtils;
interface
uses
Generics.collections, TypInfo, ObjAuto, SysUtils;
type
//
TMulticastEvent = class
private
FMethods : TList<TMethod>;
FInternalDispatcher: TMethod;
//悲催的是泛型类的方法不能内嵌汇编,只能通过一个非泛型的父类来实现
procedure InternalInvoke(Params: PParameters; StackSize: Integer);
public
constructor Create;
destructor Destroy; override;
end;
TMulticastEvent<T > = class(TMulticastEvent)
private
FEntry : T;
function ConvertToMethod(var Value):TMethod;
procedure SetEntry(var AEntry);
public
constructor Create;
destructor Destroy; override;
procedure Add(AMethod : T);
procedure Remove(AMethod : T);
function IndexOf(AMethod: T): Integer;
property Invok : T read FEntry;
end;
implementation
{ TMulticastEvent<T> }
procedure TMulticastEvent<T>.Add(AMethod: T);
var
m : TMethod;
begin
m := ConvertToMethod(AMethod);
if FMethods.IndexOf(m) < 0 then
FMethods.Add(m);
end;
function TMulticastEvent<T>.ConvertToMethod(var Value): TMethod;
begin
Result := TMethod(Value);
end;
constructor TMulticastEvent<T>.Create();
var
MethInfo: PTypeInfo;
TypeData: PTypeData;
begin
MethInfo := TypeInfo(T);
if MethInfo^.Kind <> tkMethod then
begin
raise Exception.Create('T only is Method(Member function)!');
end;
TypeData := GetTypeData(MethInfo);
Inherited;
FInternalDispatcher := CreateMethodPointer(InternalInvoke, TypeData);
SetEntry(FEntry);
end;
destructor TMulticastEvent<T>.Destroy;
begin
ReleaseMethodPointer(FInternalDispatcher);
inherited Destroy;
end;
function TMulticastEvent<T>.IndexOf(AMethod: T): Integer;
begin
Result := FMethods.IndexOf(ConvertToMethod(AMethod));
end;
procedure TMulticastEvent<T>.Remove(AMethod: T);
begin
FMethods.Remove(ConvertToMethod(AMethod));
end;
procedure TMulticastEvent<T>.SetEntry(var AEntry);
begin
TMethod(AEntry) := FInternalDispatcher;
end;
{ TMulticastEvent }
constructor TMulticastEvent.Create;
begin
FMethods := TList<TMethod>.Create;
end;
destructor TMulticastEvent.Destroy;
begin
FMethods.Free;
inherited Destroy;
end;
procedure TMulticastEvent.InternalInvoke(Params: PParameters; StackSize: Integer);
var
LMethod: TMethod;
begin
for LMethod in FMethods do
begin
//如果用到了栈(也就是Register约定参数大于2或者stdcall,cdecl约定)就把栈内所有数据都拷贝参数栈里面
if StackSize > 0 then
asm
MOV ECX,StackSize //Move的第三个参数,同时为下一步Sub ESP做准备
SUB ESP,ECX //把栈顶 - StackSize(栈是负向的)
MOV EDX,ESP //Move的第二个参数
MOV EAX,Params
LEA EAX,[EAX].TParameters.Stack[8] //Move的第一个参数
CALL System.Move
end;
//Register协议填写三个寄存器,EAX肯定是Self,如果是其他协议寄存器被填写也没啥影响
asm
MOV EAX,Params //把Params读到EAX
MOV EDX,[EAX].TParameters.Registers.DWORD[0] //EDX
MOV ECX,[EAX].TParameters.Registers.DWORD[4] //EAX
MOV EAX,LMethod.Data//把Method.Data给到EAX,如果是Register约定就是Self.否则也没影响
CALL LMethod.Code//调用Method.Data
end;
end;
end;
end.
http://blog.csdn.net/wr960204/article/details/6452158
一个灵巧的Delphi多播实事件现方案的更多相关文章
- <总结>delphi WebBrowser控件的使用中出现的bug
Delphi WebBrowser控件的使用中出现的bug: 1.WebBrowser.Visible=false:Visible属性不能使WebBrowser控件不可见,暂时用 WebBrowse ...
- 教程-Delphi第三方控件安装卸载指南
1 只有一个DCU文件的组件.DCU文件是编译好的单元文件,这样的组件是作者不想把源码公布.一般来说,作者必须说明此组件适合Delphi的哪种版本,如果版本不对,在安装时就会出现错误.也正是因为没有源 ...
- 修改Delphi工具控件的默认字体
修改Delphi工具控件的默认字体: 注册表: Delphi 6: HKEY_CURRENT_USER\Software\Borland\Delphi\6.0Delphi 7: HKEY_ ...
- Delphi WebBrowser控件的使用(大全 good)
Delphi WebBrowser控件的使用 WebBrowser控件属性:1.Application 如果该对象有效,则返回掌管WebBrowser控件的应用程序实现的自动化对象(IDis ...
- Delphi TcxtreeList控件说明 转
Delphi TcxtreeList控件说明 树.cxTreeList 属性: Align:布局,靠左,靠右,居中等 AlignWithMargins:带边框的布局 Anchors:停靠 (akT ...
- Delphi StringGrid控件的用法
Delphi StringGrid控件 组件名称:StringGrid ●固定行及固定列: StringGrid.FixedCols:=固定行之数; StringGrid.Fixe ...
- Qtp中一个或多个ActiveX控件无法显示问题
今天在使用qtp进行登陆测试的时候,发现了一个问题,现总结归纳如下: [问题] 在测试过程中,一直提醒:一个或多个ActiveX控件无法显示,原因可能是下列其中之一: 如下图所示: [解决办法] 在Q ...
- 如何分析一个已有的Delphi项目源代码
分析一个已有的Delphi项目,应该从以下入手(按先后顺序):1. 编译条件,包括自定义的Condition以及inc文件里的标识2. 主项目文件dpr,因为窗体的windows消息循环只是程序的一部 ...
- Delphi第三方控件安装卸载指南
基本安装1.对于单个控件,Componet-->install component..-->PAS或DCU文件-->install; 2.对于带*.dpk文件的控件包,File--& ...
随机推荐
- C#学习笔记3:提示“截断字符串或二进制数据”错误解决方法
1.调试程序如出现“截断字符串或二进制数据”的关于数据库的错误,可以先试一试修改数据库中字符定义的长度. 2.使用ManualResetEvent前需导入 命名空间System.Threading; ...
- selenium文件上传的实现
一.对于上传文件, 从手动操作我们可以看出, 需要对window 窗体进行操作, 而对于selenium webdriver 在这方面应用就受到了限制. 但是, 庆幸的是, 对于含有input ele ...
- asp.net 异步处理
#region 异步测试 //委托 public delegate void PrintDelegate(string s); [WebMethod] public string yibu() { / ...
- 再也不要看到Eclipse万恶的arg0,arg1提示
不知道大家跟我是否一下,遇到arg的提示. @Override public void onDateChanged(DatePicker arg0, int arg1, int arg2, int a ...
- Linux用户级线程和内核级线程区别
1.内核级线程: (1)线程的创建.撤销和切换等,都需要内核直接实现,即内核了解每一个作为可调度实体的线程.(2)这些线程可以在全系统内进行资源的竞争.(3)内核空间内为每一个内核支持线程设置了一个线 ...
- Openjudge/Poj 1183 反正切函数的应用
1.链接地址: http://bailian.openjudge.cn/practice/1183 http://poj.org/problem?id=1183 2.题目: 总时间限制: 1000ms ...
- asp.net上传Excel文件到服务端进行读取
1.我们IIS是使用7.5,由于在网站中上传Excel文件到服务端进行数据读取时候出现读取失败情况.一开始以为是没有按照office软件问题,其实不然,因为server是64位操作系统,如果我们要使用 ...
- C#实现登录窗口(不用隐藏)
C#登录窗口的实现,特点就是不用隐藏,感兴趣的朋友不要错过 (1).在程序入口处,打开登录窗口 复制代码代码如下: static void Main() { Application.EnableV ...
- 原生js在IE7下 向dom添加节点的一个bug, (本例为添加hidden input)
需求是要用js向dom结构增加1个hidden用来存放要post到服务器的数据 var aspnetForm = document.getElementById("aspnetForm&qu ...
- GPS坐标转百度地图并且加载地图示例.支持微信端访问
<%@ Page Language="C#" AutoEventWireup="true" CodeBehind="Wx_VehicleLoca ...