activation désactivation "event"

**Papy214** · 20/08/2019, 10h48

Bonjour

Ayant souvent besoin de désactiver un événement d'un composant dans le programme qui occupe la majeure partie de mon temps, j'ai voulu simplifier la chose.
Pour ne plus être obligé dans chaque procédure de déclarer un TNotifyEvent et l'utiliser pour lui assigner l'événement ciblé, mettre l'événement à nil, faire mon opération et réassigner l'événement au composant, j'ai écris vite fait le code suivant:

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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 
unit UEventManager;
 
interface
 
uses System.SysUtils, System.Classes, System.StrUtils, System.Generics.Collections,
     System.Rtti,
     FMX.Controls, FMX.StdCtrls, FMX.Listbox, FMX.Edit,
     EditNumerique;
 
type
 
  TEventManager = class(TObject)
  private
    Events: TDictionary<TControl, TNotifyEvent>;
  protected
 
  public
    constructor Create;
    destructor Destroy; override;
 
    procedure EnableEvent(Ct: TControl);
    procedure DisableEvent(Ct: TControl);
 
    function IsEnabled(Ct: TControl): Boolean;
    function IsDisabled(Ct: TControl): Boolean;
  end;
 
var
  EvtMgr: TEventManager;
 
implementation
 
{ TEventManager }
 
constructor TEventManager.Create;
begin
  inherited Create;
  Events := TDictionary<TControl, TNotifyEvent>.Create;
end;
 
destructor TEventManager.Destroy;
begin
  Events.Clear;
  FreeAndNil(Events);
  inherited;
end;
 
const
  Props: array[0..1] of string = ('OnChange', 'OnClick');
 
procedure TEventManager.DisableEvent(Ct: TControl);
var
  P: TPair<TControl, TNotifyEvent>;
begin
 
  // On ne peut pas désactiver un évènement déjà désactivé
  if Events.ContainsKey(Ct) then
    Exit;
 
  if Ct is TCheckBox then
  begin
    Events.Add(Ct, TCheckBox(Ct).OnClick);
    TCheckBox(Ct).OnClick := nil;
  end
  else if Ct is TComboBox then
  begin
    Events.Add(Ct, TComboBox(Ct).OnChange);
    TComboBox(Ct).OnChange := nil;
  end
  else if Ct is TEdit then
  begin
    Events.Add(Ct, TEdit(Ct).OnChange);
    TEdit(Ct).OnChange := nil;
  end
  else if Ct is TEditNumeric then
  begin
    Events.Add(Ct, TEditNumeric(Ct).OnChange);
    TEditNumeric(Ct).OnChange := nil;
  end;
 
end;
 
 
procedure TEventManager.EnableEvent(Ct: TControl);
var
  P: TPair<TControl, TNotifyEvent>;
  Prt: TRttiProperty;
  S: string;
begin
  if Events.ContainsKey(Ct) then
  begin
    P := Events.ExtractPair(Ct);
 
    if Ct is TCheckBox then
      TCheckBox(Ct).OnClick := P.Value
    else if Ct is TComboBox then
      TComboBox(Ct).OnChange := P.Value
    else if Ct is TRadioButton then
      TRadioButton(Ct).OnChange := P.Value
    else if Ct is TEdit then
      TEdit(Ct).OnChange := P.Value
    else if Ct is TEditNumeric then
      TEditNumeric(Ct).OnChange := P.Value;
 
  end;
end;
 
function TEventManager.IsDisabled(Ct: TControl): Boolean;
begin
  Result := Events.ContainsKey(Ct);
end;
 
function TEventManager.IsEnabled(Ct: TControl): Boolean;
begin
  Result := not Events.ContainsKey(Ct);
end;
 
initialization
  EvtMgr := TEventManager.Create;
 
finalization
  FreeAndNil(EvtMgr);
 
end.

et il s'utilise tout simplement comme ça:

Code :

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

1
2
3
4
 
UEventManager.EvtMgr.DisableEvent(EditAdd);
// .....
UEventManager.EvtMgr.EnableEvent(EditAdd);

ça fonctionne très bien et ça demanderait surement quelques améliorations mais pour le moment ça me suffit.

Mais comme vous le voyez, le côté "générique" n'y est pas vraiment.

Comment je pourrais améliorer ça pour ne pas avoir à rajouter un test sur le type de classe si je devais prendre en compte d'autres types que ceux que j'ai inclus ?

Evidemment, si l'idée de ce bout de code vous séduit, n'hésitez pas à l'utiliser

**pprem** · 20/08/2019, 14h00

Difficile de faire un truc vraiment générique, en revanche il te suffit de prendre l'ancêtre commun qui contient les événements que tu veux traiter pour ne pas avoir besoin de faire de transtypage ou en utilisant RTTI tu peux savoir si la propriété onClick ou onChange existe sur cet objet.

**Paul TOTH** · 20/08/2019, 18h07

c'est marrant, ce n'est pas une approche Delphienne du problème

si tu vas dans ce genre d'écriture, tu devrais aussi créer des classes par type de composant, TEventManger contiendrait alors une liste de TCustomComponentDisabler avec un dérivé par sous type nécessaire.

après tu as une approche plus Delphi avec TActionList qui comprend déjà un State asSuspended

et j'hésite de moins en moins à surcharger les composants de la VCL pour leur ajouter des propriétés comme Suspended dans le cas présent qui rendrait les événements inopérants.

j'utilise de plus en plus des unités comme VCLPatches qui déclare soit des Helper, soit qui surcharge des classes de bases pour les compléter.

**pprem** · 20/08/2019, 18h17

vivement qu'on puisse mettre plusieurs helpers sur la même classe pour avoir plus de liberté quand on travaille comme ça

**Cirec** · 20/08/2019, 20h03

Bonjour,

je me suis pris au jeu et j'ai tenté ma chance

voici le résultat:

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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
(*
  EventManager:
  Version originale par Papy214:
  https://www.developpez.net/forums/d1998610/environnements-developpement/delphi/langage/activation-desactivation-event/#post11093906
 
  Modifié par Cirec pour une version plus "générique"
*)
 
unit UEventManager;
 
interface
 
uses System.SysUtils, System.Classes, System.StrUtils, Generics.Defaults,
  System.Generics.Collections, System.Rtti;
 
type
 
  TObjRec = record
    aObject: TObject;
    aEventName: string;
  end;
 
  /// <summary> Comparaison personalisée de TObjRec (non case-sensitive) </summary>
  TMyRecordEqualityComparer = class(TEqualityComparer<TObjRec>)
  public
    function Equals(const Left, Right: TObjRec): Boolean; override;
    function GetHashCode(const Value: TObjRec): Integer; override;
  end;
 
  TEventManager = class(TObject)
  private
    Events: TDictionary<TObjRec, System.Rtti.TValue>;
  protected
 
  public
    constructor Create;
    destructor Destroy; override;
 
    procedure EnableEvent(aObject: TObject; aEventName: string);
    procedure DisableEvent(aObject: TObject; aEventName: string);
 
    function IsEnabled(aObject: TObject; aEventName: string): Boolean;
    function IsDisabled(aObject: TObject; aEventName: string): Boolean;
  end;
 
var
  EvtMgr: TEventManager;
 
implementation
 
{ TEventManager }
 
constructor TEventManager.Create;
begin
  inherited Create;
  Events := TDictionary<TObjRec, System.Rtti.TValue>.Create
    (TMyRecordEqualityComparer.Create);
end;
 
destructor TEventManager.Destroy;
begin
  Events.Clear;
  FreeAndNil(Events);
  inherited;
end;
 
procedure TEventManager.DisableEvent(aObject: TObject; aEventName: string);
var
  Ctx: TRttiContext;
  lType: TRttiType;
  lProperty: TRttiProperty;
  aValue: System.Rtti.TValue;
  aObjRec: TObjRec;
  P: TPair<TObjRec, System.Rtti.TValue>;
begin
  if not Assigned(aObject) then
    Exit;
  aObjRec.aObject := aObject;
  aObjRec.aEventName := aEventName;
  if Events.ContainsKey(aObjRec) then
    Exit;
  Ctx := TRttiContext.Create;
  try
    lType := Ctx.GetType(aObject.ClassInfo);
    if not Assigned(lType) then
      Exit;
 
    for lProperty in lType.GetDeclaredProperties do
    begin
      if SameText(lProperty.Name, aEventName) then
      begin
        aValue := lProperty.GetValue(aObject);
        lProperty.SetValue(aObject, nil);
        Events.Add(aObjRec, aValue);
      end;
    end
  finally
    Ctx.free;
  end;
end;
 
procedure TEventManager.EnableEvent(aObject: TObject; aEventName: string);
var
  Ctx: TRttiContext;
  lType: TRttiType;
  lProperty: TRttiProperty;
  aObjRec: TObjRec;
  P: TPair<TObjRec, System.Rtti.TValue>;
begin
  if not Assigned(aObject) then
    Exit;
  aObjRec.aObject := aObject;
  aObjRec.aEventName := aEventName;
  if Events.ContainsKey(aObjRec) then
  begin
    P := Events.ExtractPair(aObjRec);
    Ctx := TRttiContext.Create;
    try
      lType := Ctx.GetType(aObject.ClassInfo);
      if not Assigned(lType) then
        Exit;
 
      for lProperty in lType.GetDeclaredProperties do
      begin
        if SameText(lProperty.Name, aEventName) then
          lProperty.SetValue(aObject, P.Value);
      end;
    finally
      Ctx.free;
    end;
  end;
end;
 
function TEventManager.IsDisabled(aObject: TObject; aEventName: string)
  : Boolean;
var
  aObjRec: TObjRec;
begin
  Result := False;
  aObjRec.aObject := aObject;
  aObjRec.aEventName := aEventName;
  Result := Events.ContainsKey(aObjRec);
end;
 
function TEventManager.IsEnabled(aObject: TObject; aEventName: string): Boolean;
var
  aObjRec: TObjRec;
begin
  aObjRec.aObject := aObject;
  aObjRec.aEventName := aEventName;
  Result := not Events.ContainsKey(aObjRec);
end;
 
{ TMyRecordEqualityComparer }
 
function TMyRecordEqualityComparer.Equals(const Left, Right: TObjRec): Boolean;
begin
  Result := (Left.aObject = Right.aObject) and
    (CompareText(Left.aEventName, Right.aEventName) = 0);
end;
 
function TMyRecordEqualityComparer.GetHashCode(const Value: TObjRec): Integer;
begin
  Result := Length(Value.aEventName);
end;
 
initialization
 
EvtMgr := TEventManager.Create;
 
finalization
 
FreeAndNil(EvtMgr);
 
end.

c'est du vite fait et ça reste perfectible mais cette version permet de désactiver plusieurs Events d'un même objet
et de les réactiver au choix.

Exemples d'utilisation:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.Button6Click(Sender: TObject);
begin
  EvtMgr.DisableEvent(Button4, 'OnClick');
  EvtMgr.DisableEvent(Edit1, 'OnKeyPress');
  EvtMgr.DisableEvent(Edit1, 'OnClick');
end;
 
procedure TForm1.Button7Click(Sender: TObject);
begin
  EvtMgr.EnableEvent(Button4, 'OnClick');
  EvtMgr.EnableEvent(Edit1, 'OnKeyPress');
  EvtMgr.EnableEvent(Edit1, 'OnClick');
end;

Cordialement,

@+

**Papy214** · 22/08/2019, 17h27

"c'est marrant, ce n'est pas une approche Delphienne du problème" ...

Sans doute parce que je suis en tain de m'initier au développement de site WEB et que je vais peu à peu changer d'orientation ...
J'ai regardé vite fait le site sur VCLPatches .... à étudier

**Papy214** · 22/08/2019, 17h31

Envoyé par Cirec

Bonjour,

je me suis pris au jeu et j'ai tenté ma chance

voici le résultat:[CODE](*
EventManager:
Version originale par Papy214:
https://www.developpez.net/forums/d1998610/environnements-developpement/delphi/langage/activation-desactivation-event/#post11093906

Modifié par Cirec pour une version plus "générique"
*)

@+

Pas mal du tout ... ça laisse même la possibilité d'ajouter une fonction qui prendrait en paramètre un tableau d’événements à prendre en compte.
Joli boulot

activation désactivation "event"

Langage Delphi

Discussions similaires

Partager

Partager