Discussion :

[Rayek]

Bonjour,

Je débute sur l'utilisation des class Helper et j'aurais voulu savoir si parmi vous certain avait tenté la "dérivation" d'un évènement ?

En gros j'aimerai intercepter le Onclick d'un TButton pour faire des actions avant et après le onclick original.

Est ce possible avec le class Helper ?

Merci

[chaplin]

Et pourquoi ne pas utiliser le procédure Click de TButton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 TButton = class (StdCtrls.TButton)
 
...
procedure Click; override;

[Rayek]

Et pourquoi ne pas utiliser le procédure Click de TButton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 TButton = class (StdCtrls.TButton)
 
...
procedure Click; override;

Car avec cette méthode je suis obligé de créer un composant et de remplacer tous les composants de l'application.

Alors qu'avec le Class Helper j'ai juste à rajouter une unité dans les uses des forms au pire

[ShaiLeTroll]

Normalement, si tu redéfini une propriété complètement en héritage, cela fonctionne, mais en class Helper, c'est effectivement interressant à savoir

Je n'ai que D7, sous la main, en héritage, ça devrait donner ça, avec le Helper, voir comment appeler une propriété hérité qui ne l'est pas vraiement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
THelperButton = class helper for TButton
private
  FOnClick: TNotifyEvent; 
public
  constructor Create(...); override; // on surcharge ???
published
  ...
  property OnClick: TNotifyEvent read FOnClick write FOnClick;
...
 
constructor THelperButton.Create(...);
begin
  inherited Create(...);
 
  inherited OnClick := ClickInternalEventHandler;
end;
 
procedure THelperButton.ClickInternalEventHandler(Sender: TObject);
begin
  // Code Perso
 
  OnClick(Sender);
end;

[LadyWasky]

Mais non, mais non


Voici la version simplifiée pour comprendre (une fiche et un bouton dedans)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  // astuce pour dériver les TButton du DFM sans ajouter le composant à la palette :)  <--Merci Paul Toth
  TButton = class(StdCtrls.TButton)
    procedure Click; override;
  end; 
 
  TForm1 = class(TForm)
     Button1 : TButton;
     procedure Button1Click(Sender:TObject);
  private
    {Déclarations privées}
  public
     {Déclarations publiques}
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Coucou');
end;
 
{ TButton }
 
procedure TButton.Click;
begin
  ShowMessage('Avant Click');
  inherited; //cette ligne déclenche le OnClick normal, tu peux la commenter
  // ou même poser une condition : 
  // if variable=valeur then inherited;
  ShowMessage('Après Click');
end;

Ensuite, pour que chaque bouton aie son OnBeforeClick et On AfterClick, voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TButton=class(stdctrls.Tbutton)
  private
    FOnBeforeClick: TNotifyEvent;
    FOnAfterClick: TNotifyEvent;
    procedure SetOnAfterClick(const Value: TNotifyEvent);
    procedure SetOnBeforeClick(const Value: TNotifyEvent);
  published
  public
    procedure Click; override;
    property OnBeforeClick:TNotifyEvent read FOnBeforeClick write SetOnBeforeClick;
    property OnAfterClick:TNotifyEvent read FOnAfterClick write SetOnAfterClick;
  end;
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button 2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject); 
    procedure FormCreate  (Sender: TObject);
  private
    { Déclarations privées }
    //Ces 2 procédures suivantes, sont rajoutées "à la main" dans le code 
    //de la fiche (on ne peut pas le faire depuis l'inspecteur d'objet) :
    procedure Button1AfterClick(Sender: TObject);
    procedure Button2BeforeClick(Sender: TObject);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
procedure TForm1FormCreate  (Sender: TObject);
begin
   //ça, on ne peut pas l'attribuer aux boutons depuis l'inspecteur d'objet,
   // donc on le fait à la main, ici :
   Button1.OnAfterClick:=Button1AfterClick;
   Button1.OnBeforeClick:=Button1BeforeClick;
end;
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Coucou 1');
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessage('Coucou 2');
end;
 
 
//Ces 2 procédures suivantes, sont rajoutées "à la main" dans le code de la fiche (on ne peut pas le faire depuis l'inspecteur d'objet :
procedure TForm1.Button1AfterClick(Sender: TObject);
begin
   Showmessage('Après click du bouton 1');
end;
 
procedure TForm1.Button2BeforeClick(Sender: TObject);
begin
   Showmessage('Avant click du bouton 2');
end;
 
{ TButton }
 
procedure TButton.Click;
begin
  if assigned(FOnBeforeClick) then FOnBeforeClick(self);
  inherited;
   if assigned(FOnAfterClick) then FOnAfterClick(self);  
end;
 
procedure TButton.SetOnAfterClick(const Value: TNotifyEvent);
begin
  FOnAfterClick := Value;
end;
 
procedure TButton.SetOnBeforeClick(const Value: TNotifyEvent);
begin
  FOnBeforeClick := Value;
end;
 
end.

Voilà et je n'ai pas l'impression que le class Helper ajoute quelque chose, enfin bon

[chaplin]

Car avec cette méthode je suis obligé de créer un composant et de remplacer tous les composants de l'application.

J'ai fait un test et je n'ai pas eu besoin de créer un composant, la contre partie, c'est qu'il faut déclarer l'unité comportant la classe dans toutes les unités qui l'utilisent .

EDIT: La réponse est dans le post précédent, il faut juste exporter le code dans une autre unité.

[Rayek]

J'avais déjà essayé un truc du style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
type
  TBitBtnHelper = class Helper for TBitBtn
  private
    FOnClick: TNotifyEvent;
    procedure ClickEvent(Sender : TObject);
  public
    constructor Create (Owner : TComponent); override;
  published
    property OnClick : TNotifyEvent read FOnClick write FOnclick;
  end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
{ TBitBtnHelper }
 
procedure TBitBtnHelper.ClickEvent(Sender: TObject);
begin
  Showmessage('Avant');
  OnClick(Sender);
  Showmessage('Apres');
end;
 
constructor TBitBtnHelper.Create(Owner : TComponent);
begin
  inherited Create(Owner);
 
  Inherited OnClick := ClickEvent;
end;

Mais je me retrouve avec une erreur sur le FOnClick :

[DCC Erreur] MainCMB_Frm.pas(63): E2169 Définition de champ non autorisée après des méthodes ou propriétés

[LadyWasky]

Mais je me retrouve avec une erreur sur le FOnClick

Classique

Déjà, Il faut appeler le code d'un évènement comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if Assigned(FOnClick) then FOnClick(Sender)

des fois qu'il ne serait pas codé coté composant de la fiche


Edit : et comme le soulève Chaplin, redéfinir une méthode existante avec un class helper, ça ne marche pas.

[chaplin]

Les classs helper permettent de rajouter des méthodes uniquement, exit les propriétés et exit également la redéfinition des méthodes et propriétés d'après ce que j'ai compris ... .

Class helpers provide a way to extend a class, but they should not be viewed as a design tool to be used when developing new code. They should be used solely for their intended purpose, which is language and platform RTL binding.

[LadyWasky]

Les classs helper permettent de rajouter des méthodes uniquement, exit les propriétés et exit également la redéfinition des méthodes et propriétés d'après ce que j'ai compris ... .

Oui, donc c'est très limité, il me semblait bien aussi

[Andnotor]

C'est ce que j'ai compris aussi

Par contre, une chose intéressante par rapport à un héritage classique et de pouvoir créer un assistant de classe TControl et que tout les composants en héritant puissent en profiter

Un exemple serait l'ajout d'un méthode AsInteger qui permette la conversion d'un texte en entier, qu'il s'agisse d'un TEdit, TLabel, TComboBox ou autres.

[Rayek]

bizarre je suis pourtant tomber sur des exemples qui utilises les TNotifyEvent

Pas en français mais ca montre bien que l'utilisation d'event est possible

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
type
  TBitBtnHelper = class Helper for TBitBtn
  Class Var
    FOnClick: TNotifyEvent;
  public
    procedure ClickEvent(Sender : TObject);
    constructor Create (Owner : TComponent); override;
  end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
{ TBitBtnHelper }
 
procedure TBitBtnHelper.ClickEvent(Sender: TObject);
begin
  Showmessage('Avant');
  If Assigned(FOnClick) then FOnClick(Sender);
  Showmessage('Apres');
end;
 
constructor TBitBtnHelper.Create(Owner : TComponent);
begin
  inherited Create(Owner);
  FOnClick := Self.OnClick; 
  Self.OnClick:= ClickEvent;
end;

ca ne fonctionne pas mais pourtant ca ressemble a ce qui a été fait dans le liens ci dessus.

Même en mettant un point d'arret dans le créate, ca n'y passe jamais

[LadyWasky]

On a pas dis qu'il était impossiple de rajouter des évènements, on a dit qu'il était impossible de modifier des méthodes (procédures, fonctions) déjà existantes dans la classe de base (et ça vaut aussi pour des variables comme FOnClick qui sont déjà définies dans les classes parentes (TWindowControl)).

Vois-tu la subtilité ?

[Rayek]

On a pas dis qu'il était impossiple de rajouter des évènements, on a dit qu'il était impossible de modifier des méthodes (procédures, fonctions) déjà existantes dans la classe de base (et ça vaut aussi pour des variables comme FOnClick qui sont déjà définies dans les classes parentes (TWindowControl)).

Vois-tu la subtilité ?

Oui pas de soucis.

Enfin bon, même en m'inspirant du code (indiqué plus haut) j'ai toujours mon soucis

J'ai testé son code et ca passe bien dans le OnActivate des forms (celle créée de base et celles créées dynamiquement). alors que ca ne passe pas dans le OnClick de mon bouton

[chaplin]

Dans l'exemple de LadyWasky, la classe est déclarée dans la même unité. Si tu la déclare dans une autre unité, en fait cette unité ne déclare que cette classe, il faut veiller à la mettre dans les uses après l'unité dans laquelle elle est officiellement déclarée, ici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
uses
  ..., StdCtrls, MyButtonUnit, ...

[Franck SORIANO]

ca ne fonctionne pas mais pourtant ca ressemble a ce qui a été fait dans le liens ci dessus.

Le problème c'est qu'il faudrait que le Create du class Helper s'execute après le Loaded de la Form.
Dans l'exemple que tu as montré, le class Helper était définit sur la Form. Lorsque son Create est terminée, les propriétés publiées ont été lues depuis le DFM.
Dans ton cas, le OnClick que tu mets en place sera écrasé lors du chargement du DFM. Qui plus est, tu aurais un problème si tu as plusieurs boutons...

on a dit qu'il était impossible de modifier des méthodes (procédures, fonctions) déjà existantes dans la classe de base

En fait, on peut parfois obtenir un comportement similaire.

Récemment je me suis servit d'un class helper pour modifier Application.ProcessMessages :
J'ai définit un class helper pour TApplication, en lui définissant une méthode ProcessMessages.
Ensuite, à la compile le compilateur a compris qu'il fallait appeler la méthode ProcessMessages du class helper au lieu de celle de TApplication, partout où les unités référencaient la déclaration du class helper.
Comme j'ai déclaré le class helper dans une unité référencée par tout le projet, j'ai réussit masquer Application.ProcessMessages partout dans le projet, en une seule déclaration et sans modifier chaque appel.
Ca aurait été difficile à faire autrement.

En gros j'aimerai intercepter le Onclick d'un TButton pour faire des actions avant et après le onclick original.

C'est marrant, je réfléchissais justement à une façon de le faire la semaine dernière.
Voici les idées auxquelles j'ai pensé :
- Delphi XE possède une nouvelle classe TVirtualMethodInterceptor qui permet d'intercepter les méthodes virtuelles. Sauf que d'après ce que j'ai pu voir, ça ne fonctionne que sur une instance, pas pour une classe donnée.
- Ensuite je me suis dit qu'une solution simple serait de patcher dynamiquement la VMT d'une classe. Dans le cas du Click, il faut le faire sur la DMT :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 
type
  TDynamicIndexList = array[0..MaxInt div 16] of Word;
  PDynamicIndexList = ^TDynamicIndexList;
  TDynamicAddressList = array[0..MaxInt div 16] of Pointer;
  PDynamicAddressList = ^TDynamicAddressList;
 
 
function GetDynamicMethodCount(AClass: TClass): Integer;
asm
       MOV     EAX, [EAX].vmtDynamicTable
       TEST    EAX, EAX
       JE      @@exit
       MOVZX   EAX, Word ptr [EAX]
@@exit:
end;
 
function GetDynamicIndexList(AClass: TClass): PDynamicIndexList;
asm
       MOV      EAX, [EAX].vmtDynamicTable
       ADD      EAX, 2
end;
 
function GetDynamicAddressList(AClass: TClass): PDynamicAddressList;
asm
       MOV      EAX, [EAX].vmtDynamicTable
       MOVZX    EDX, Word ptr [EAX]
       ADD      EAX, EDX
       ADD      EAX, EDX
       ADD      EAX, 2
end;
 
function GetDynMethodPatch(AClass : TClass; idx : Word) : PPointer;
var
  nb : integer;
  i : integer;
  IndexList : PDynamicIndexList;
  MethodList : PDynamicAddressList;
begin
  repeat
    nb := GetDynamicMethodCount(AClass);
    if nb >0
    then begin
      IndexList := GetDynamicIndexList(AClass);
      MethodList := GetDynamicAddressList(AClass);
 
      for i := 0 to nb-1 do
      begin
        if IndexList[i] = idx
        then begin
          result := @(MethodList[i]);
          exit;
        end;
      end;
    end;
    AClass := AClass.ClassParent;
  until not Assigned(AClass);
  result := nil;
end;
 
procedure InstallIntercept(AClass : TClass);
var
  nb : integer;
  IndexList : PDynamicIndexList;
  MethodList : PDynamicAddressList;
  i : integer;
  idx : integer;
  Original : pointer;
  PatchOriginal : PPointer;
  PatchIntercept : PPointer;
  oldProtect : cardinal;
begin
  nb := GetDynamicMethodCount(AClass);
  IndexList := GetDynamicIndexList(AClass);
  MethodList := GetDynamicAddressList(AClass);
  for i := 0 to nb-1 do
  begin
    idx := IndexList[i];
 
    PatchOriginal := GetDynMethodPatch(AClass.ClassParent, idx);
    PatchIntercept := @(MethodList[i]);
 
    Original := PatchOriginal^;
    VirtualProtect(PatchOriginal, sizeof(pointer), PAGE_READWRITE, @oldProtect);
    PatchOriginal^ := PatchIntercept^;
    VirtualProtect(PatchOriginal, sizeof(pointer), oldProtect, nil);
 
    VirtualProtect(PatchIntercept, sizeof(pointer), PAGE_READWRITE, @oldProtect);
    PatchIntercept^ := Original;
    VirtualProtect(PatchIntercept, sizeof(pointer), oldProtect, nil);
  end;
end;

Puis à l'utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
type
  TInterceptButton = class(TCustomButton)
  public
    procedure Click; override;
  end;
 
procedure TInterceptButton.Click;
begin
  // Action avant click
  inherited Click;
  // Action après click
end;
 
initialization
  InstallIntercept(TInterceptButton);
end.

Ensuite, tu crées une fiche, tu poses quelques TButton (qui dérivent de TCustomButton) dessus.
Lorsque tu clique sur le TButton,... miracle, c'est Click de TInterceptButton qui est appelé. Et le plus marrant c'est que lorsque TInterceptButton appelle la méthode héritée, on appelle bien la méthode Click du TCustomButton, alors que sa DMT a été modifiée...

Sur le coup je me suis dit que c'était bon. Sauf que ça n'aurait pas dû marcher. J'ai désassemblé le code pour comprendre pourquoi ça marchait. Et j'ai découvert que lorsque une classe appelle la méthode hérité, l'appel à cette dernière est résolu de façon statique, sans interroger la VMT ou la DMT de la classe parente.

Concrêtement, ça veut dire que cette technique ne permet d'intercepter que la dernière surcharge de la méthode.
Ca marche avec TButton parce que Click n'est pas surchargée dans TButton. Mais si on avait une classe dérivée de TButton, qui surchargerait la méthode Click, elle aurait sa propre DMT différente de celle qui est patchée pour que l'appel se fasse bien sur la méthode de la classe dérivée.
Ensuite lorsque cette dernière fairait l'appel de la méthode héritée, elle appelerait statiquement le click de TCustomButton, et mon interception ne fonctionnerait pas...
Donc ça marche dans certains cas, mais pas toujours...

- Enfin il reste la solution de l'injection de code sur la méthode Click. Il existe quelques librairies qui permettent de faire ce genre de chose : Il s'agit alors de patcher dynamiquement le code assembleur de la méthode Click pour qu'elle commence son exécution en appelant une autre méthode.

Bon celà dit, c'est de la bidouille. La solution propre c'est qu'en même de surcharger TButton et d'utiliser la classe dérivée (éventuellement avec une substitution statique en appelant la classe dérivée TButton).

[chaplin]

Bon celà dit, c'est de la bidouille. La solution propre c'est qu'en même de surcharger TButton et d'utiliser la classe dérivée (éventuellement avec une substitution statique en appelant la classe dérivée TButton).

Je suis d'accord avec la conclusion, cependant il est toujours intéressant d'avoir une regard d'expert sur les possibilités qu'offre le compilateur de contourner certaines difficultés. C'est franchement intéressant .

[Rayek]

Merci a tous pour vos interventions qui éclaircissent certain points obscurs du développement sur les objets

Sinon, ma problématique n'est pas vraiment sur un TButton (ou TBitBtn) qui ne me servait que pour comprendre le fonctionnement du Class Helper.

Le problème que l'on rencontre dans une application, c'est que l'auteur d'origine a utilisé des TLmdSpeedButton (Version 6 migré pour D2007 ) de partout (Entre 100 et 150 forms avec 2 boutons minimum) et que lors d'un double clic sur ceux-ci, le TLMDSpeedButton exécute deux fois le code à la suite et génère des violations d'accès....

Ce que je cherche à faire c'est de mettre en place un verrou sur le bouton afin d'empêcher l'exécution du code deux fois (faire un simple test sur un boolean) et le Class Helper avait l'air séduisant pour faire cela

La surcharge a l'air sympathique, mais j'ai peur que cela soit difficile à mettre en place surtout avec ces composants un peu spéciaux.

Quelle(s) solution(s) pensez vous est il préférable de mettre en place et qui ne soit pas trop complexe ?

[LadyWasky]

Juste comme ça....
Est ce que par hasard, il n'y aurait pas non plus des TActionList dans les fiches ? (ce qui expliquerais le côté "double action", peut-être)

Sinon, vous ouvrez tous les .dfm et .pas et vous remplacez tous les "TLMDSpeedButton" que vous trouverez par "TButton". Il restera à enlever dans les dfm, les quelques propriétés restées en trop et hop.
Vu le peu de temps que ça devrait prendre avec une moulinette "maison", ça vaudrait le coup de tester cette solution. Pensez à faire ça sur une copie du code, au cas où vous auriez besoin de revenir au code original !

[chaplin]

+1, je suis confronté aux mêmes problèmes et c'est la façon la plus "simple" et radicale d'éradiquer le problème.