有的时候 ,我们希望给所有的控件的某个指定的事件挂接一个自定义的事件处理程序 ,例如 ,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;