看了網上大牛的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了，都不知道如何改，因為太高級了。。。。
