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;