Discussion :

[Delphi-ne]

J'ai un objet TPageControl qui contient plusieurs graphes (un graphe par TTabShhet)

Au moment ou l'utilisateur sélectionne un onglet particulier je voudrais afficher une popup en ShowModal et si la réponse n'est pas mrOK ne pas afficher le TTabSheet.

Je pense donc mettre cela dans l'évènement OnChanging du TPageControl et affecter la variable AllowChanging en fonction de la réponse fournie par la méthode ShowModal.
Ce que je ne sais pas faire c'est savoir sur quel onglet l'utilisateur veut aller.
Je sais sur lequel il est mais pas celui ou il va.
Je ne peux pas itiliser la métode Enter du TTabShhet puisqu'il n'y a pas d'objet de saisie

Si quelqu'un a une idée je prends

[ShaiLeTroll]

Il est vrai que ce n'est pas clair dansVcl.ComCtrls.TPageControl.OnChanging

mais l'on peut extrapoler depuis l'exemple PageControlChanging (Delphi) que l'on peut utiliser ActivePage qui n'a pas encore changé de valeur

Pour OnChange, ActivePage est déjà modifié

On pourrait assimiler OnChanging à OnTabExit et OnChange à un OnTabEnter

[e-ric]

Hi

J'ai trouvé un fil de discussion assez ancien, pas de solution direct selon celui-ci
https://groups.google.com/forum/#!to...sc/m5oaCuWVKsw
Sinon, as-tu regardé les sources de Delphi pour cet objet, en recherchant les occurences de FOnChanging, tu trouveras peut-être une piste, espérons qu'il existe une solution dorénavant.

N'ayant pas Delphi au boulot, je peux pas faire la recherche.

@+

[Delphi-ne]

Merci

Les deux solutions fonctionnent.
L'inconvénient de celle qui s'appuie sur les évènements onChange / onChanging est qu' l'utilisateur voit l'onglet avant qu'on ne l'en dégage le cas échéant.

La seconde produit un résultat vraiment clean.
Elle mémorise la position de la souris et à partir de là détermine l'onglet sur lequel elle se trouve.

Voici un code d'exemple :

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
Uses commctrl;
 
var
    Form1: TForm1;
    LN_X, LN_Y : integer;
 
 
procedure TForm1.PageControl1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  LN_X := X;
  LN_Y := Y;
end;
 
 
procedure TForm1.PageControl1Changing(Sender: TObject;
  var AllowChange: Boolean);
var
  LO_HitTestInfo : TTCHitTestInfo;
  LN_Onglet      : Integer;
begin
  LO_HitTestInfo.Pt := Point(LN_X, LN_Y);
  LN_Onglet         := PageControl1.Perform(TCM_HitTest, 0, integer(@LO_HitTestInfo));
  ShowMessage(IntToStr(LN_Onglet));
end;

Merci à tous les deux

[ShaiLeTroll]

L'inconvénient de celle qui s'appuie sur les évènements onChange / onChanging est qu' l'utilisateur voit l'onglet avant qu'on ne l'en dégage le cas échéant.

OnChanging qui se produit avant le changement et OnChange après
Je n'avais pas compris la question, tu veux protéger l'entrée dans un onglet et non pas la sortie !
C'est vrai que j'ai souvent protéger la sortie et rarement l'entrée !

Au lieu d'un TPageControl utilise TTabControl, ce n'est pas un conteneur !
Il faut gérer soit même l'affichage, souvent par un jeu de Panel, de Frame de Form ancrée instancié à la volée, ainsi on ne voit pas le contenu de l'onglet si on refuse l'affichage (juste un petit scintillement sur l'onglet)

le sujet mentionné date de 1999 c'est à dire Delphi 4 au mieux !
Toujours pas de d'astuce pour savoir où l'on va AVANT d'en changer !

Il serait intéressant d'avoir le code du Perform\HitTest dans une classe d'assistance (soit à l'ancienne, soit via les class helper)

si j'ai le temps, je fournis le classe d'assistance à l'ancienne à partir d'un code procédural mais réutilisable que j'avais pondu il y a un paquet d'année !


EDIT :

Code en XE2 (devrait être le même en D7) pour protéger la Sortie d'un onglet ainsi que l'entrée !

Un seul event OnChanging !
Pas de OnMouseMove (j'utilise Screen.CursorPos et ScreenToClient dans TPageControlAssistant)
Code réutilisable de TPageControlAssistant !

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
procedure TModuleEDIImportCommandeForm.pgc1Changing(Sender: TObject;
  var AllowChange: Boolean);
var
  PageIndex: Integer;
  ToTabMsg: string;
begin
  with TPageControlAssistant.Create(Sender) do
  try
    if GetPageAtScreen(PageIndex) then
      ToTabMsg := ' pour aller vers l''onglet ' + pgc1.Pages[PageIndex].Caption;
 
    AllowChange := MessageDlg('Vous quittez l''onglet ' + pgc1.ActivePage.Caption + ToTabMsg, mtConfirmation, mbOKCancel, 0) = mrOk;
  finally
    Free();
  end;
end;
 
(*procedure TModuleEDIImportCommandeForm.pgc1Change(Sender: TObject);
begin
  ShowMessage('Vous entrez dans l''onglet ' + pgc1.ActivePage.Caption);
end;*)

il l'unité complète contenant TPageControlAssistant et TListViewAssistant :
Je suis en train de reprendre pas mal de truc écrit en D6, BCB2007, BCBXE2 de regrouper le tout dans des unités (bon plutôt conçu pour XE2)

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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
unit SLTComCtrlsEx;
 
interface
 
uses SysUtils, Types, Classes,
  Controls, ComCtrls, Menus,
  Windows, CommCtrl;
 
type
  /// <summary>Erreur liée à l'assistant TListViewAssistant de la classe TListView</summary>
  EListViewAssistantError = class(Exception);
 
  /// <summary>Assistance de la classe TListView </summary>
  /// <remarks>Le TListViewAssistant n'est pas un class helper car lors de sa création en 2002 sous Delphi 5, le code était procédural,
  /// lors de la refonte en classe en 2007, la version utilisée était Delphi 7, en s'inspirant du concept des Assistances de classes (Class Helper) du Delphi.NET</remarks>
  TListViewAssistant = class(TObject)
  private
    // Membres privés
    FListView: TListView;
 
    // Accesseurs
    function GetCell(ACol, ARow: Integer): string;
    function GetSubCell(ACol, ARow: Integer): string;
    procedure SetCell(ACol, ARow: Integer; const Value: string);
    procedure SetSubCell(ACol, ARow: Integer; const Value: string);
    function GetObject(ACol, ARow: Integer): TObject;
    function GetSubObject(ACol, ARow: Integer): TObject;
    procedure SetObject(ACol, ARow: Integer; const Value: TObject);
    procedure SetSubObject(ACol, ARow: Integer; const Value: TObject);
  public
    // Constructeurs
    constructor Create(AListView: TListView); overload;
    constructor Create(Sender: TObject); overload;
 
    // Méthodes
 
    /// <summary>Renvoie l'item ou le sous-item sous le point spécifié de la zone cliente de la vue liste.</summary>
    /// <param name="X">X est la coordonnée en x du point spécifié de la zone cliente de la vue liste.</param>
    /// <param name="Y">Y est la coordonnée en y du point spécifié de la zone cliente de la vue liste.</param>
    /// <param name="ACol">0 indique un Item, 1 à n indique un sous-item</param>
    /// <param name="ARow">Indique la position de l'élément de liste dans la collection TListItems.</param>
    /// <returns>True si trouve l'Index de l'item ou du sous-item (Col et Row en Base 0), False si il n'y pas de sous-item à cette position client</returns>
    function GetItemAt(X, Y: Integer; out ACol, ARow: Integer): Boolean;
 
    /// <summary>Renvoie l'item ou le sous-item sous le point spécifié par le curseur de la souris.</summary>
    /// <param name="ACol">0 indique un Item, 1 à n indique un sous-item</param>
    /// <param name="ARow">Indique la position de l'élément de liste dans la collection TListItems.</param>
    /// <returns>True si trouve l'Index de l'item ou du sous-item (Col et Row en Base 0), False si il n'y pas de sous-item à cette position écran</returns>
    function GetItemAtScreen(out ACol, ARow: Integer): Boolean;
 
    /// <summary>Renvoie le sous-item sous le point spécifié de la zone cliente de la vue liste.</summary>
    /// <param name="X">X est la coordonnée en x du point spécifié de la zone cliente de la vue liste.</param>
    /// <param name="Y">Y est la coordonnée en y du point spécifié de la zone cliente de la vue liste.</param>
    /// <param name="ACol">Indice dans SubItems</param>
    /// <param name="ARow">Indique la position de l'élément de liste dans la collection TListItems.</param>
    /// <returns>True si trouve l'Index du sous-item (Col et Row en Base 0), False si il n'y pas de sous-item à cette position client</returns>
    function GetSubItemAt(X, Y: Integer; out ACol, ARow: Integer): Boolean;
 
    /// <summary>Renvoie le sous-item sous le point spécifié par le curseur de la souris.</summary>
    /// <param name="ACol">Indice dans SubItems</param>
    /// <param name="ARow">Indique la position de l'élément de liste dans la collection TListItems.</param>
    /// <returns>True si trouve l'Index du sous-item (Col et Row en Base 0), False si il n'y pas de sous-item à cette position écran</returns>
    function GetSubItemAtScreen(out ACol, ARow: Integer): Boolean;
 
    // Propriétés
    property ListView: TListView read FListView;
 
    /// <summary>Renvoie le contenu d'un item ou d'un sous-item, la première ligne est la ligne zéro, la colonne Item est la colonne zéro et les colonnes pointant vers SubItems sont les suivantes.</summary>
    property Cells[ACol, ARow: Integer]: string read GetCell write SetCell;
    /// <summary>Renvoie uniquement le contenu d'un sous-items la première ligne est la ligne zéro, la première colonne comme SubItems est la colonne zéro.</summary>
    property SubCells[ACol, ARow: Integer]: string read GetSubCell write SetSubCell;
    /// <summary>Renvoie l'objet associé d'un item ou d'un sous-item, la première ligne est la ligne zéro, la colonne Item est la colonne zéro et les colonnes pointant vers SubItems sont les suivantes.</summary>
    property Objects[ACol, ARow: Integer]: TObject read GetObject write SetObject;
    /// <summary>Renvoie uniquement le contenu d'un sous-items la première ligne est la ligne zéro, la première colonne comme SubItems est la colonne zéro.</summary>
    property SubObjects[ACol, ARow: Integer]: TObject read GetSubObject write SetSubObject;
  end;
 
  /// <summary>Evenement OnClick d'un TListViewPopupMenuItem</summary>
  TListViewPopupMenuItemClickEvent = procedure(Sender: TObject; AListView: TListView; ACol, ARow: Integer) of object;
 
  /// <summary>Evolution du MenuItem conçue pour être associée à une colonne et ligne d'un TListView via Item.Data ou SubItems.Objects</summary>
  TListViewPopupMenuItem = class(TMenuItem)
  private
    FListView: TListView;
    FCol: Integer;
    FRow: Integer;
    FOnClick: TListViewPopupMenuItemClickEvent;
 
    procedure ClickEventHander(Sender: TObject);
  public
    constructor Create(AOwner: TComponent; AListView: TListView; ACol, ARow: Integer); reintroduce;
 
    property ListView: TListView read FListView;
    property Col: Integer read FCol;
    property Row: Integer read FRow;
    property OnClick: TListViewPopupMenuItemClickEvent read FOnClick write FOnClick;
  end;
 
  /// <summary>Erreur liée à l'assistant TPageControlAssistant de la classe TPageControl</summary>
  EPageControlAssistantError = class(Exception);
 
  /// <summary>Assistance de la classe TPageControl </summary>
  /// <remarks>Le TPageControlAssistant n'est pas un class helper car lors de sa création en 2002 sous Delphi 5, le code était procédural,
  /// lors de la refonte en classe en 2007, la version utilisée était Delphi 7, en s'inspirant du concept des Assistances de classes (Class Helper) du Delphi.NET</remarks>
  TPageControlAssistant = class(TObject)
  private
    // Membres privés
    FPageControl: TPageControl;
  public
    // Constructeurs
    constructor Create(APageControl: TPageControl); overload;
    constructor Create(Sender: TObject); overload;
 
    // Méthodes
 
    /// <summary>Renvoie l'Index de la page sous le point spécifié de la zone cliente du contrôle onglet.</summary>
    /// <param name="X">X est la coordonnée en x du point spécifié de la zone cliente du contrôle onglet.</param>
    /// <param name="Y">Y est la coordonnée en y du point spécifié de la zone cliente du contrôle onglet.</param>
    /// <param name="PageIndex">0 indique un Item, 1 à n indique un sous-item</param>
    /// <returns>True si trouve l'Index de la page (PageIndex eb Base 0), False si il n'y pas de page à cette position client</returns>
    function GetPageAt(X, Y: Integer; out PageIndex: Integer): Boolean;
 
    /// <summary>Renvoie l'Index de la page sous le point spécifié par le curseur de la souris.</summary>
    /// <param name="PageIndex">0 indique un Item, 1 à n indique un sous-item</param>
    /// <returns>True si trouve l'Index de la page (PageIndex eb Base 0), False si il n'y pas de page à cette position</returns>
    function GetPageAtScreen(out PageIndex: Integer): Boolean;
 
    // Propriétés
    property PageControl: TPageControl read FPageControl;
  end;
 
 
 
implementation
 
const
  ERR_UNASSISTED_CLASS = 'La Classe d''Assistance %s ne prend pas en charge la classe %s mais la classe %s';
 
{ TListViewAssistant }
 
//------------------------------------------------------------------------------
constructor TListViewAssistant.Create(AListView: TListView);
begin
  inherited Create();
 
  FListView := AListView;
end;
 
//------------------------------------------------------------------------------
constructor TListViewAssistant.Create(Sender: TObject);
begin
  inherited Create();
 
  if Assigned(Sender) then
  begin
    if Sender is TListView then
      FListView := TListView(Sender)
    else
      raise EListViewAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), Sender.ClassName(), TListView.ClassName()]);
  end
  else
    raise EListViewAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), '[nil]', TListView.ClassName()])
end;
 
//------------------------------------------------------------------------------
function TListViewAssistant.GetCell(ACol, ARow: Integer): string;
begin
  if ACol <= 0 then
    Result := ListView.Items.Item[ARow].Caption
  else
    Result := SubCells[ACol - 1, ARow];
end;
 
//------------------------------------------------------------------------------
function TListViewAssistant.GetItemAt(X, Y: Integer; out ACol, ARow: Integer): Boolean;
var
  LstClicInfo: TLVHitTestInfo;
begin
  LstClicInfo.pt := Point(X, Y);
  ARow := ListView.Perform(LVM_SUBITEMHITTEST, 0, LPARAM(@LstClicInfo));
  ACol := LstClicInfo.iSubItem;
  Result := (ARow >= 0) and (ACol >= 0);
end;
 
//------------------------------------------------------------------------------
function TListViewAssistant.GetItemAtScreen(out ACol, ARow: Integer): Boolean;
var
  ClientPoint: TPoint;
begin
  ClientPoint := ListView.ScreenToClient(Mouse.CursorPos);
  Result := GetItemAt(ClientPoint.X, ClientPoint.Y, ACol, ARow);
end;
 
//------------------------------------------------------------------------------
function TListViewAssistant.GetObject(ACol, ARow: Integer): TObject;
begin
  if ACol <= 0 then
    Result := TObject(ListView.Items.Item[ARow].Data)
  else
    Result := SubObjects[ACol - 1, ARow];
end;
 
//------------------------------------------------------------------------------
function TListViewAssistant.GetSubCell(ACol, ARow: Integer): string;
begin
  Result := ListView.Items.Item[ARow].SubItems.Strings[ACol];
end;
 
//------------------------------------------------------------------------------
function TListViewAssistant.GetSubItemAt(X, Y: Integer; out ACol, ARow: Integer): Boolean;
begin
  Result := False;
  if GetItemAt(X, Y, ACol, ARow) then
  begin
    Dec(ACol); // 0 était la Position de l'Item, décale pour l'accès via SubItems
    Result := ACol >= 0;
  end;
end;
 
//------------------------------------------------------------------------------
function TListViewAssistant.GetSubItemAtScreen(out ACol, ARow: Integer): Boolean;
begin
  Result := False;
  if GetItemAtScreen(ACol, ARow) then
  begin
    Dec(ACol);
    Result := (ARow >= 0) and (ACol >= 0);
  end;
end;
 
//------------------------------------------------------------------------------
function TListViewAssistant.GetSubObject(ACol, ARow: Integer): TObject;
begin
  Result := ListView.Items.Item[ARow].SubItems.Objects[ACol];
end;
 
//------------------------------------------------------------------------------
procedure TListViewAssistant.SetCell(ACol, ARow: Integer; const Value: string);
begin
  if ACol <= 0 then
    ListView.Items.Item[ARow].Caption := Value
  else
    SubCells[ACol - 1, ARow] := Value;
end;
 
//------------------------------------------------------------------------------
procedure TListViewAssistant.SetObject(ACol, ARow: Integer; const Value: TObject);
begin
  if ACol <= 0 then
    ListView.Items.Item[ARow].Data := Value
  else
    SubObjects[ACol - 1, ARow] := Value;
end;
 
//------------------------------------------------------------------------------
procedure TListViewAssistant.SetSubCell(ACol, ARow: Integer; const Value: string);
begin
  ListView.Items.Item[ARow].SubItems.Strings[ACol] := Value;
end;
 
//------------------------------------------------------------------------------
procedure TListViewAssistant.SetSubObject(ACol, ARow: Integer; const Value: TObject);
begin
  ListView.Items.Item[ARow].SubItems.Objects[ACol] := Value;
end;
 
{ TListViewPopupMenuItem }
 
//------------------------------------------------------------------------------
procedure TListViewPopupMenuItem.ClickEventHander(Sender: TObject);
begin
  if Assigned(FOnClick) then
    if Sender is TListViewPopupMenuItem then
      FOnClick(Sender, TListViewPopupMenuItem(Sender).FListView, TListViewPopupMenuItem(Sender).Col, TListViewPopupMenuItem(Sender).Row);
end;
 
//------------------------------------------------------------------------------
constructor TListViewPopupMenuItem.Create(AOwner: TComponent; AListView: TListView; ACol, ARow: Integer);
begin
  inherited Create(AOwner);
 
  FListView := AListView;
  FCol := ACol;
  FRow := ARow;
  inherited OnClick := ClickEventHander;
end;
 
{ TPageControlAssistant }
 
//------------------------------------------------------------------------------
constructor TPageControlAssistant.Create(APageControl: TPageControl);
begin
  inherited Create();
 
  FPageControl := APageControl;
end;
 
//------------------------------------------------------------------------------
constructor TPageControlAssistant.Create(Sender: TObject);
begin
  inherited Create();
 
  if Assigned(Sender) then
  begin
    if Sender is TPageControl then
      FPageControl := TPageControl(Sender)
    else
      raise EPageControlAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), Sender.ClassName(), TPageControl.ClassName()]);
  end
  else
    raise EPageControlAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), '[nil]', TPageControl.ClassName()])
 
end;
 
//------------------------------------------------------------------------------
function TPageControlAssistant.GetPageAt(X, Y: Integer; out PageIndex: Integer): Boolean;
var
  TabClicInfo: TTCHitTestInfo;
begin
  TabClicInfo.pt := Point(X, Y);
  PageIndex := PageControl.Perform(TCM_HITTEST, 0, LPARAM(@TabClicInfo));
  Result := PageIndex >= 0;
end;
 
//------------------------------------------------------------------------------
function TPageControlAssistant.GetPageAtScreen(out PageIndex: Integer): Boolean;
var
  ClientPoint: TPoint;
begin
  ClientPoint := PageControl.ScreenToClient(Mouse.CursorPos);
  Result := GetPageAt(ClientPoint.X, ClientPoint.Y, PageIndex);
end;
 
end.

[Delphi-ne]

Franchement la solution qui consiste à déterminer l'onglet cible à partir de la souris est vraiment une solution assez propre au niveau dutilisateur.

On peut toujous trouver autre chose mais dans le présent l'utilisateur semble satisfait