Project Structure

• AnonButton.dpr
• AnonButton_MainForm.pas
• AnonButton_MainForm.dfm {FormAnonButton}

program AnonButton;

uses
  Forms,
  AnonButton_MainForm in 'AnonButton_MainForm.pas' {FormAnonButton};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormAnonButton, FormAnonButton);
  Application.Run;
end.

unit AnonButton_MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TAnonNotif = reference to procedure (Sender: TObject);

  // interceptor class
  TButton = class (StdCtrls.TButton)
  private
    FAnonClick: TAnonNotif;
    procedure SetAnonClick(const Value: TAnonNotif);
  public
    procedure Click; override;
  public
    property AnonClick: TAnonNotif read FAnonClick write SetAnonClick;
  end;

  TFormAnonButton = class(TForm)
    btnInvoke: TButton;
    btnAssign: TButton;
    btnKeepRef: TButton;
    btnLeftInvokeForm: TButton;
    btnRightInvokeForm: TButton;
    procedure btnAssignClick(Sender: TObject);
    procedure btnKeepRefClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormAnonButton: TFormAnonButton;

implementation


{$R *.dfm}

procedure TFormAnonButton.btnAssignClick(Sender: TObject);
begin
  btnInvoke.AnonClick :=
    procedure (Sender: TObject)
    begin
      ShowMessage ((Sender as TButton).Caption);
    end;
end;

{ TAnonButton }

procedure TButton.Click;
begin
  // execute this before standard processing
  // (including running OnClick)
  if Assigned (FAnonClick) then
    FAnonClick (self);
  inherited;
end;

procedure TButton.SetAnonClick(const Value: TAnonNotif);
begin
  FAnonClick := Value;
end;


procedure TFormAnonButton.btnKeepRefClick(Sender: TObject);
var
  aCompRef: TComponent;
begin
  aCompRef := Sender as TComponent;
  btnInvoke.AnonClick :=
    procedure (Sender: TObject)
    begin
      ShowMessage ((Sender as TButton).Caption + ' assigned by ' +
        aCompRef.Name);
    end;
end;

procedure TFormAnonButton.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    btnLeftInvokeForm.AnonClick :=
      procedure (Sender: TObject)
      begin
        (Sender as TButton).Caption :=
          'Last left on [' +
            IntToStr (X) + ',' + IntToStr (Y) + ']';
      end
  else
    btnRightInvokeForm.AnonClick :=
      procedure (Sender: TObject)
      begin
        (Sender as TButton).Caption :=
          'Last right on [' +
            IntToStr (X) + ',' + IntToStr (Y) + ']';
      end;
end;

end.

object FormAnonButton: TFormAnonButton
  Left = 0
  Top = 0
  Caption = 'AnonButton'
  ClientHeight = 276
  ClientWidth = 320
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnMouseDown = FormMouseDown
  PixelsPerInch = 96
  TextHeight = 13
  object btnInvoke: TButton
    Left = 168
    Top = 80
    Width = 75
    Height = 25
    Caption = 'btnInvoke'
    TabOrder = 0
  end
  object btnAssign: TButton
    Left = 64
    Top = 64
    Width = 75
    Height = 25
    Caption = 'btnAssign'
    TabOrder = 1
    OnClick = btnAssignClick
  end
  object btnKeepRef: TButton
    Left = 64
    Top = 96
    Width = 75
    Height = 25
    Caption = 'btnKeepRef'
    TabOrder = 2
    OnClick = btnKeepRefClick
  end
  object btnLeftInvokeForm: TButton
    Left = 32
    Top = 168
    Width = 211
    Height = 25
    Caption = 'btnLeftInvokeForm'
    TabOrder = 3
  end
  object btnRightInvokeForm: TButton
    Left = 64
    Top = 199
    Width = 217
    Height = 25
    Caption = 'btnRightInvokeForm'
    TabOrder = 4
  end
end