失败的大牛事件委托，与我的委托

看了网上大牛的DELPHI事件委托，实际用起来是有BUG的。代码如下：

unit faDelegate;

interface

uses
　　Generics.collections, TypInfo, ObjAuto, SysUtils;
type
　　Event = class
　　　　private
　　　　　　FMethods : TList<TMethod>;
　　　　　　FInternalDispatcher: TMethod;
　　　　　　//悲催的是泛型类的方法不能内嵌汇编,只能通过一个非泛型的父类来实现
　　　　　　procedure InternalInvoke(Params: PParameters; StackSize: Integer);
　　　　public
　　　　　　constructor Create;
　　　　　　destructor Destroy; override;
　　end;

Event<T> = class(Event)
　　private
　　　　FObj:TObject;
　　　　FProName:string;

　　　　FEntry : T;
　　　　function ConvertToMethod(var Value):TMethod;
　　　　procedure SetEntry(var AEntry);
　　public
　　　　constructor Create(Obj:TObject;ProName:String );
　　　　destructor Destroy; override;
　　　　procedure Add(AMethod : T);
　　　　procedure Remove(AMethod : T);
　　　　function IndexOf(AMethod: T): Integer;

　　　　// property Invok : T read FEntry;
　　end;

implementation

{ Event<T> }

procedure Event<T>.Add(AMethod: T);
var
　　m : TMethod;
begin
　　m := ConvertToMethod(AMethod);
　　if ((m.Code<>nil) and (FMethods.IndexOf(m) < 0)) then
　　FMethods.Add(m);
end;

function Event<T>.ConvertToMethod(var Value): TMethod;
begin
　　Result := TMethod(Value);
end;

constructor Event<T>.Create(Obj:TObject;ProName:String );
var
　　MethInfo: PTypeInfo;
　　TypeData: PTypeData;
　　m:TMethod;
　　p:Pointer;
begin
　　MethInfo := TypeInfo(T);
　　if MethInfo^.Kind <> tkMethod then //检测T的类型
　　　　raise Exception.Create('T only is Method(Member function)!');

　　TypeData := GetTypeData(MethInfo);

　　Inherited Create();
　　FInternalDispatcher := CreateMethodPointer(InternalInvoke, TypeData); //把InternalInvoke的函数地址转为TMethod
　　SetEntry(FEntry); //FEntry是入口地址,设为FInternalDispatcher

　　FObj:=Obj;
　　FProName:=ProName;

　　m:=GetMethodProp(FObj,FProName);
　　p:=@m;
　　Add(T(p^)); //先添加对象原有的方法
　　SetMethodProp(FObj,FProName,FInternalDispatcher); //设定对象的入口
end;

destructor Event<T>.Destroy;
begin
　　ReleaseMethodPointer(FInternalDispatcher); //和CreateMethodPointer是一对的，正好相反

　　inherited Destroy;
end;

function Event<T>.IndexOf(AMethod: T): Integer;
begin
　　Result := FMethods.IndexOf(ConvertToMethod(AMethod));
end;

procedure Event<T>.Remove(AMethod: T);
begin
　　FMethods.Remove(ConvertToMethod(AMethod));
end;

procedure Event<T>.SetEntry(var AEntry);
begin
　　TMethod(AEntry) := FInternalDispatcher;
end;

{ Event }

constructor Event.Create;
begin
　　FMethods := TList<TMethod>.Create;
end;

destructor Event.Destroy;
begin
　　FMethods.Free;
　　inherited Destroy;
end;

procedure Event.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;

 

 

BUG体验在对TDBGridEh中的列的事件OnupdateData做委托时，对Value参数赋值会有错误！晕，不知道怎么办好！所以只好用自己的方法解决！

我的事件委托：

Delegate<T>=class
　　private
　　　　i:integer;
　　　　FEntrance:TMethod;
　　protected
　　　　Delegates:array of TMethod;
　　　　procedure AddMethod(m:TMethod);
　　　　function GetRunEof():Boolean;
　　　　function GetRun():T;
　　public
　　　　constructor Create(C: TObject;ProName:string);virtual;
　　　　destructor Destroy; override;
　　　　procedure Add(Delegate:T);

end;

DeNotify=class(Delegate<TNotifyEvent>)
　　published
　　　　procedure DoRun(Sender:TObject);
end;

 

implementation

 

procedure Delegate<T>.Add(Delegate: T);
var m:TMethod;
　　p:Pointer;
begin
　　p:=@Delegate;
　　m:=Tmethod(p^);
　　AddMethod(Tmethod(p^));
end;

procedure Delegate<T>.AddMethod(m: TMethod);
begin
　　if ((m.Code=nil) or (m.Data=nil)) then exit;
　　if (m.Code<>FEntrance.Code) then begin
　　SetLength(Delegates,High(Delegates)+2);
　　Delegates[High(Delegates)]:=m;
end;
end;

constructor Delegate<T>.Create(C: TObject; ProName: string);
begin
　　FEntrance.Data:=Self;
　　FEntrance.Code:=MethodAddress('DoRun');

　　AddMethod(GetMethodProp(c,ProName));
　　SetMethodProp(c,ProName,FEntrance);
　　i:=0;

　　// if Assigned(lstDelegates)=false then begin
　　// lstDelegates:=TList.Create;
　　lstDelegates.Add(Self);
　　// end;
end;

destructor Delegate<T>.Destroy;
begin
　　Dec(iTotal);
　　// if lstDelegates.Count=0 then
　　// lstDelegates.Free
　　// else
　　lstDelegates.Delete(lstDelegates.IndexOf(self));

　　inherited;
end;

 

function Delegate<T>.GetRun: T;
var m:TMethod;
　　p:Pointer;
begin
　　m:=Delegates[i-1];
　　p:=@m;
　　Result:=T(p^);
end;

function Delegate<T>.GetRunEof: Boolean;
begin
　　Result:=not (i<=High(delegates));
　　if Result=false then
　　　　Inc(i)
　　else
　　　　i:=0;
end;

procedure DeNotify.DoRun(Sender: TObject);
begin
　　while not GetRunEof() do
　　　　GetRun()(Sender);
end;

这个方法有很大的缺点，就是一种事件类型要派生一个类！但实在，没有什么问题。

看来事物都有两面性，浓缩很大的代码，做起来很有技巧，很高难度，而且会比较容易出错。

如果浓缩不大的代码，所需要的技巧不多，容易理解，但是冗余又比较多。不爽。

不过，无论如何，正确是第一的。技巧再高，不正确也没有用。第一种方法好象很强大，但有BUG了，都不知道如何改，因为太高级了。。。。

 

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有