Delphi 给窗体上面所有的控件都挂上一个事件处理过程华软源码

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