How to set event handler for generic TControl descendant using RTTI

[CoMPi74 3]

Hi there,

 

I'm struggling with the problem for several hours and I can't solve it.

function TMyForm.CreateControl(AClass: TControlClass): TControl;

  procedure SetDefaultEventHandlerIfEventExists(const AControl: TControl; const AEvent, AHandler: string); 
  begin
    if IsPublishedProp(AControl, AEvent) then SetMethodProp(AControl, AEvent, GetMethodProp(Self, AHandler));
  end;

begin
  Result := AClass.Create(Self);
  Result.Parent := Self;
  
  SetDefaultEventHandlerIfEventExists(Result, 'OnClick', 'DoOnClick');
  SetDefaultEventHandlerIfEventExists(Result, 'OnDblClick', 'DoOnDblClick');
  [... a few other events ...]
  
  // Since all 'DoOnEvent's are private, local methods of TMyForm I would prefer to use something like below, but I can not manage it to work. What have I missed?
  SetDefaultEventHandlerIfEventExists2(Result, 'OnClick', DoOnClick);
  SetDefaultEventHandlerIfEventExists2(Result, 'OnDblClick', DoOnDblClick);
end;

Can anyone enlighten me? What have I missed?

 

PS. I forgot to mention, I use Delphi XE4. Yes, I know, it's a bit old 😉 

Edited June 13, 2023 by CoMPi74
Some corrections and additions

[PeaShooter_OMO 11]

What is inside SetDefaultEventHandlerIfEventExists2?

Edited June 13, 2023 by PeaShooter_OMO

[CoMPi74 3]

7 minutes ago, PeaShooter_OMO said:

What is inside SetDefaultEventHandlerIfEventExists2?

That's the problem :) I do not know. But, in general, it would be modified version of `SetDefaultEventHandlerIfEventExists`... 

[PeaShooter_OMO 11]

What are the symptoms? Errors?

Edited June 13, 2023 by PeaShooter_OMO

[CoMPi74 3]

For implementation, like below, 

function TMyForm.CreateControl(AClass: TControlClass): TControl;

  procedure SetDefaultEventHandlerIfEventExists2(const AControl: TControl; const AEvent: string; const AHandler: TMethod); 
  begin
    if IsPublishedProp(AControl, AEvent) then SetMethodProp(AControl, AEvent, AHandler);
  end;

begin
  Result := AClass.Create(Self);
  Result.Parent := Self;
  
  SetDefaultEventHandlerIfEventExists2(Result, 'OnClick', DoOnClick);
  SetDefaultEventHandlerIfEventExists2(Result, 'OnDblClick', DoOnDblClick);
  [... a few other events ...]
end;

I got 'E2035 Not enough actual parameters' error... Using '@DoOnClick gives exactly the same error...

Edited June 13, 2023 by CoMPi74

[Stefan Glienke 2002]

Event types and TMethod while binary compatible (both consist of the data and code pointer) they are not assignment compatible.

 

This routine will work for all event handlers that have the TNotifyEvent signature but not for others (such as mouse or key-related ones that have additional parameters).

For those, you need to write overloads.

 

procedure SetDefaultEventHandlerIfEventExists2(const AControl: TControl;
  const AEvent: string; const AHandler: TNotifyEvent);
begin
  if IsPublishedProp(AControl, AEvent) then
    SetMethodProp(AControl, AEvent, TMethod(AHandler));
end;

 

Edited June 13, 2023 by Stefan Glienke

[PeaShooter_OMO 11]

Did you search for the error on the web?

 

SetMethodProp needs TMethod which can be setup.... Have a look at How to set a procedure (function) to an event in delphi 7?

[Peet Terluin 0]

Something like this will work. You need to use a "holder"-control for the eventmethods  you want to assign.

 

procedure TForm5.btnCreateControlClick(Sender: TObject);
var
  btn: TButton;
begin
  btn := TButton.Create(self);
  btn.Caption := 'Click';
  btn.Left := 10;
  btn.Top := 10;
  btn.Parent := self;
  if IsPublishedProp(btn, 'OnClick') then
    SetMethodProp(btn, 'OnClick', GetMethodProp(fProcHolder, 'OnClick'));
end;

procedure TForm5.DoOnClick(Sender: TObject);
begin
  ShowMessage('Hello');
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  fProcHolder := TEdit.Create(self);
  fProcHolder.OnClick := DoOnClick;
end;

 

 

[CoMPi74 3]

4 minutes ago, Peet Terluin said:

Something like this will work. You need to use a "holder"-control for the eventmethods  you want to assign.

 

procedure TForm5.btnCreateControlClick(Sender: TObject);
var
  btn: TButton;
begin
  btn := TButton.Create(self);
  btn.Caption := 'Click';
  btn.Left := 10;
  btn.Top := 10;
  btn.Parent := self;
  if IsPublishedProp(btn, 'OnClick') then
    SetMethodProp(btn, 'OnClick', GetMethodProp(fProcHolder, 'OnClick'));
end;

procedure TForm5.DoOnClick(Sender: TObject);
begin
  ShowMessage('Hello');
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  fProcHolder := TEdit.Create(self);
  fProcHolder.OnClick := DoOnClick;
end;

 

 

Can' t use GetMethodProp because I prefer all my event handlers to be strict private.

[PeaShooter_OMO 11]

15 minutes ago, Stefan Glienke said:

Event types and TMethod while binary compatible (both consist of the data and code pointer) they are not assignment compatible.

TMethod in System is a record with a Code and Data pointer. Would it be possible to browse Delphi's source code to find any source code to verify Event types' structure or is the knowledge about Event types found in documentaion only?

[Stefan Glienke 2002]

5 minutes ago, PeaShooter_OMO said:

TMethod in System is a record with a Code and Data pointer. Would it be possible to browse Delphi's source code to find any source code to verify Event types' structure or is the knowledge about Event types found in documentaion only?

https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Procedural_Types_(Delphi)#Method_Pointers

[CoMPi74 3]

@Stefan Glienke you are genius, really. Now it works as expected. Thanks a million.

 

But, by the way, I have another question. Because all these overloads shades the code, then, instead of   

function TMyForm.CreateControl(AClass: TControlClass): TControl;

  procedure SetEventHandler(const AControl: TControl; const AEventName: string; const AEventHandler: TNotifyEvent); overload;
  begin
    if IsPublishedProp(AControl, AEventName) then SetMethodProp(AControl, AEventName, TMethod(AEventHandler));
  end;

  procedure SetEventHandler(const AControl: TControl; const AEventName: string; const AEventHandler: TKeyEvent); overload;
  begin
    if IsPublishedProp(AControl, AEventName) then SetMethodProp(AControl, AEventName, TMethod(AEventHandler));
  end;

  [...]

begin
  Result := AClass.Create(Self);
  Result.Parent := Self;

  SetEventHandler(Result, 'OnClick', DoOnClick);
  SetEventHandler(Result, 'OnKeyDown', DoOnKeyDown);
  SetEventHandler(Result, 'OnChange', DoOnChange);
  SetEventHandler(Result, 'OnSelect', DoOnSelect);
end;

I wanted to use something like this

function TMyForm.CreateControl(AClass: TControlClass): TControl;
begin
  Result := AClass.Create(Self);
  Result.Parent := Self;

  if IsPublishedProp(Result, 'OnClick') then SetMethodProp(Result, 'OnClick', TMethod(TNotifyEvent(DoOnClick)));
  if IsPublishedProp(Result, 'OnKeyDown') then SetMethodProp(Result, 'OnKeyDown', TMethod(TKeyEvent(DoOnKeyDown)));
  [...]
end;

But I get 'E2089 Invalid typecast' error. Is not it the same? Any suggestions?

[PeterBelow 238]

4 hours ago, CoMPi74 said:

Hi there,

 

I'm struggling with the problem for several hours and I can't solve it.

Can anyone enlighten me? What have I missed? 

 

PS. I forgot to mention, I use Delphi XE4. Yes, I know, it's a bit old 😉 

An event reference you need for SetMethodProp is not a simple method address, it is a record of type TMethod, which holds a pair of pointers, the first (Code) is the address of the method and the second (Data) is the address of the class holding the method. You have to construct the value to pass like this, a typecast as you tried does not quite work for some reason:

 

function TMyForm.CreateControl(AClass: TControlClass): TControl;
var
  LEvent: TMethod;
  procedure SetEvent(const aEventName: string; aMethodAdr: Pointer);
  begin
    if IsPublishedProp(Result, aEventName) then begin
      LEvent.Code := aMethodAdr;
      SetMethodProp(Result, aEventName, LEvent);
    end;
  end;
begin
  Result := AClass.Create(Self);
  Result.Parent := Self;
  LEvent.Data := self;

  SetEvent('OnClick', @DoOnClick);
  SetEvent('OnKeyDown', @DoOnKeyDown);
  [...]
end;

 

[Peet Terluin 0]

4 hours ago, CoMPi74 said:

Can' t use GetMethodProp because I prefer all my event handlers to be strict private.

There are (as allways...) many ways to solve this, you can pick the solution you want.

But ... there's no reason why "DoOnClick"  in my earlier example cannot be strict private. It can.

 

Unit5.pas

[CoMPi74 3]

6 hours ago, Peet Terluin said:

[...] But ... there's no reason why "DoOnClick" in my earlier example cannot be strict private [...]

Actually, there is. "DoOnClick" can not be a strict private method if you want to use GetMethodProp. That was I wanted to say. Anyway, thank you for you response, which shows me different point of view for my problem :)

[CoMPi74 3]

7 hours ago, PeterBelow said:

An event reference you need for SetMethodProp is not a simple method address, it is a record of type TMethod, which holds a pair of pointers, the first (Code) is the address of the method and the second (Data) is the address of the class holding the method. You have to construct the value to pass like this, a typecast as you tried does not quite work for some reason:

 

function TMyForm.CreateControl(AClass: TControlClass): TControl;
var
  LEvent: TMethod;
  procedure SetEvent(const aEventName: string; aMethodAdr: Pointer);
  begin
    if IsPublishedProp(Result, aEventName) then begin
      LEvent.Code := aMethodAdr;
      SetMethodProp(Result, aEventName, LEvent);
    end;
  end;
begin
  Result := AClass.Create(Self);
  Result.Parent := Self;
  LEvent.Data := self;

  SetEvent('OnClick', @DoOnClick);
  SetEvent('OnKeyDown', @DoOnKeyDown);
  [...]
end;

 

Nice piece of code. But I can not compile it. I get 'E2036 Variable required' in SetEvent('OnClick', @DoOnClick). To be honest, I experienced similar problem - I was not able to get the address of the event handler method.

[programmerdelphi2k 237]

@CoMPi74

 

uses
  System.TypInfo;

type // procedural type: reference a method of an instance object
  TMyNotifyToMouseUp = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;

procedure MySetEventHandler(AObj: TObject; AEventName: string; AMethod: TMethod);
begin
  if IsPublishedProp(AObj, AEventName) then
    begin
      // TMethod = record Code, Data: Pointer; ...
      SetMethodProp(AObj, AEventName, AMethod);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LNewButton           : TButton;
  LNewButtonName       : string;
  LEventProp           : TNotifyEvent; // TNotifyEvent = procedure(Sender: TObject) of object;
  LEventNotifyToMouseUp: TMyNotifyToMouseUp;
begin
  DateTimeToString(LNewButtonName, '_ss_zzz', now);
  //
  LNewButton        := TButton.Create(self);
  LNewButton.Name   := 'Btn' + LNewButtonName;
  LNewButton.Parent := self;
  LNewButton.Left   := random(ClientWidth - LNewButton.Width);
  LNewButton.Top    := random(ClientHeight - LNewButton.Height);
  //
  LEventProp   := DoOnClick;
  MySetEventHandler(LNewButton, 'OnClick', TMethod(LEventProp));
  //
  LEventNotifyToMouseUp := DoMouseUp;
  MySetEventHandler(LNewButton, 'OnMouseUp', TMethod(LEventNotifyToMouseUp));
end;

procedure TForm1.DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ShowMessage('OnMouseUp ' + TControl(Sender).Name);
end;

procedure TForm1.DoOnClick(Sender: TObject);
begin
  ShowMessage('OnClick ' + TControl(Sender).Name);
end;

initialization

ReportMemoryLeaksOnShutdown := true;
randomize;

end.

 

Edited June 14, 2023 by programmerdelphi2k

[PeterBelow 238]

11 hours ago, CoMPi74 said:

Nice piece of code. But I can not compile it. I get 'E2036 Variable required' in SetEvent('OnClick', @DoOnClick). To be honest, I experienced similar problem - I was not able to get the address of the event handler method.

Try to use @TMyForm.DoOnClick instead or @Self.DoOnClick, perhaps that works.

[CoMPi74 3]

@programmerdelphi2k Thank you :)

[CoMPi74 3]

2 hours ago, PeterBelow said:

Try to use @TMyForm.DoOnClick instead or @Self.DoOnClick, perhaps that works.

@PeterBelowIt does not work with @Self but works, perfectly, with @TMyForm. Nice catch! Thank you. 

[programmerdelphi2k 237]

@CoMPi74

 

try this way too:

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    // OR... strict private
    procedure DoOnClick(Sender: TObject);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;
...

procedure MySetEventHandler(AObj: TObject; AEventName: string; AMethod: TMethod);
begin
  if IsPublishedProp(AObj, AEventName) then
      SetMethodProp(AObj, AEventName, AMethod);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LNewButton    : TButton;
  LNewButtonName: string;
  LMethod: TMethod;
begin
  DateTimeToString(LNewButtonName, '_ss_zzz', now);
  //
  LNewButton        := TButton.Create(self);
  LNewButton.Name   := 'Btn' + LNewButtonName;
  LNewButton.Parent := self;
  LNewButton.Left   := random(ClientWidth - LNewButton.Width);
  LNewButton.Top    := random(ClientHeight - LNewButton.Height);
  //
  LMethod.Data := @LNewButton;
  LMethod.Code := @TForm1.DoOnClick;
  MySetEventHandler(LNewButton, 'OnClick', LMethod); // works!
  //
  LMethod.Data := @LNewButton;
  LMethod.Code := @TForm1.DoMouseUp; // namespace.proceduralType = method
  MySetEventHandler(LNewButton, 'OnMouseUp', LMethod); // works!
end;

procedure TForm1.DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ShowMessage('OnMouseUp ' + TControl(Sender).Name);
end;

procedure TForm1.DoOnClick(Sender: TObject);
begin
  ShowMessage('OnClick ' + TControl(Sender).Name);
end;

 

 

Edited June 14, 2023 by programmerdelphi2k