有的时候，我们希望给所有的控件的某个指定的事件挂接一个自定义的事件处理程序，例如，OnContextPopup事件，那么该如何做呢？
请参看下面的代码，下面的代码会给所有有OnContextPopu事件的控件都挂接指定的处理程序：
private
{ Private declarations }
procedure AssignOnContextPopupEvent ;
procedure OnContextPopup ( Sender : TObject ; MousePos : TPoint ;
var Handled : Boolean );
public
{ Public declarations }
end ;
var
Form1 : TForm1 ;
implementation
{$R *.dfm}
uses
TypInfo ;
procedure TForm1 . MonthCalendar1GetMonthInfo ( Sender : TObject ;
Month : Cardinal ; var MonthBoldInfo : Cardinal );
begin
if Month = 9 then { April}
MonthCalendar1 . BoldDays ([ 3 , 21 , 28 ], MonthBoldInfo ); { Day 3, 21, 28 }
end ;
procedure TForm1 . OnContextPopup ( Sender : TObject ; MousePos : TPoint ;
var Handled : Boolean );
begin
with Sender as TComponent do
ShowMessage ( Name + ' right-clicked!' );
end ;
procedure TForm1 . AssignOnContextPopupEvent ;
var
i : Integer ;
PropInfo : PPropInfo ;
Method : TMethod ;
PEvent : ^ TContextPopupEvent ;
begin
for i := 0 to ComponentCount - 1 do
begin
PropInfo := GetPropInfo ( Components [ i ]. ClassInfo , 'OnContextPopup' );
if ( PropInfo <> nil ) and ( PropInfo ^. PropType ^^. Kind = tkMethod ) then
begin
Method := GetMethodProp ( Components [ i ], PropInfo );
if not Assigned ( Method . Code ) then
begin
PEvent := @ Method . Code ;
PEvent ^ := OnContextPopup ;
Method . Data := Self ;
SetMethodProp ( Components [ i ], PropInfo , Method );
end ;
end ;
end ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
AssignOnContextPopupEvent ;
end ;
*****************************************
如果要清除所有的事件也可以！
//使用 GetPropCount 可取得控件的的属性计数:
function GetPropCount(Instance: TPersistent): Integer;
var
Data: PTypeData;
begin
Data := GetTypeData(Instance.Classinfo);
Result := Data^.PropCount;
end;
//使用 GetPropName 可取得属性的名称：
function GetPropName(Instance: TPersistent; Index: Integer): string;
var
PropList: PPropList;
PropInfo: PPropInfo;
Data: PTypeData;
begin
Result := '';
Data := GetTypeData(Instance.Classinfo);
GetMem(PropList, Data^.PropCount * Sizeof(PPropInfo));
try
GetPropInfos(Instance.ClassInfo, PropList);
PropInfo := PropList^[Index];
Result := PropInfo^.Name;
finally
FreeMem(PropList, Data^.PropCount * Sizeof(PPropInfo));
end;
end;
procedure CloseForm(Form: TForm);
var
Index: Integer;
src: TPersistent;
SrcPropInfo: PPropInfo;
MyMethod: TMethod;
j: integer;
begin
with Form do
begin
for j := 0 to ComponentCount - 1 do
begin
src := TPersistent(Components[j]);
for Index := 0 to GetPropCount(Src) - 1 do
begin
SrcPropInfo := GetPropInfo(Src.ClassInfo, GetPropName(Src, Index));
if (srcPropInfo <> nil) and (SrcPropInfo^.PropType^.Kind = tkMethod)
then
begin
MyMethod := GetMethodProp(Src, SrcPropInfo);
if (Assigned(MyMethod.Data)) and (Assigned(MyMethod.Code)) then
begin
MyMethod.Data := nil;
MyMethod.Code := nil;
SetMethodProp(Src, SrcPropInfo, MyMethod);
end;
end;
end;
end;
end;
end;