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

2018-06-17 18:57:46来源:未知 阅读 ()

新老客户大回馈,云服务器低至5折

看了网上大牛的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
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:[修正] 移动平台曲线不平滑的问题(如:TRectangle, TPath...等

下一篇:[函数] Firemonkey Windows 重新计算 Font Baseline