IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Voir le flux RSS

Blog de Serge Girard (aka SergioMaster)

[Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop

Noter ce billet
par , 22/04/2021 à 09h06 (1657 Affichages)
Passons à un peu plus sérieux.

Nom : ScpahEchelle_small.PNG
Affichages : 1753
Taille : 85,1 Ko

Après avoir étudié les évènements spécifiques au TControlList dans les précédents billets

Nom : Capture_6.PNG
Affichages : 8303
Taille : 36,9 Ko

les opérations de drag&drop étant proposées, j'ai trouvé intéressant de me pencher dessus. Je pense que bien m'en a pris, car cela m'a permis de me confronter à quelques problématiques inhérentes au concept de ce composant, m'obligeant à faire de la plongée profonde dans les sources et découvrir, avouons-le, des parties de codes qui m'ont déstabilisé ou frustré !

Plantons le décor :

Nom : Capture.PNG
Affichages : 280
Taille : 38,1 Ko

L'objectif principal est d'attacher à un élément de la liste de gauche, une image contenue dans la liste de droite. Le premier défi est déjà d'avoir une variable quelconque pour stocker les données, bien sûr il y a la possibilité d'une table, mais j'ai plutôt choisi d'utiliser une simple collection (un TDictionnary<integer,integer>) avec comme clé le numéro de l'élément et comme valeur un numéro d'image.

Afficher une liste d'image est assez simple, les données utilisées sont de fait celle de la collection d'image. L'image présentée au sein de la liste étant une image virtuelle liée à la collection, changer sa propriété ImageIndex fait le boulot.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
procedure TFormDragdrop.ControlListImagesBeforeDrawItem(AIndex: Integer; ACanvas: TCanvas;
  ARect: TRect; AState: TOwnerDrawState);
begin
  VirtualImage3.ImageIndex := AIndex;
end;
Pour afficher la liste de gauche il ne faut guère plus d'astuce
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
procedure TFormDragdrop.ControlListGaucheBeforeDrawItem(AIndex: Integer; ACanvas: TCanvas;
  ARect: TRect; AState: TOwnerDrawState);
var
  imagenumber: Integer;
begin
  lblTitre.Caption := 'Item ' + AIndex.ToString;   // affichage du titre
  if ItemImages.TryGetValue(AIndex, imagenumber) then  // affichage de l'image chosie
    VirtualImage1.ImageIndex := imagenumber
  else
    VirtualImage1.ImageIndex := -1;
end;
Dans les deux cas il s'agit d'utiliser, ce que j'ai déjà décrit dans mes divers billets : l'évènement OnBeforeDrawItem du TControlList.

Nom : Capture_2.PNG
Affichages : 255
Taille : 108,0 Ko
*La capture d'écran ne rend pas hommage au programme, aussi je vous invite à lancer la vidéo via ce lien

Comment en suis-je arrivé là ?
Pour initier l'opération de glissement
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
procedure TFormDragdrop.ControlListImagesMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  itemidx := ControlListImages.ItemIndex;  // mémorisation de l'index 
  if (Button = mbLeft) AND (ssShift in Shift) then
    ControlListImages.BeginDrag(true);
end;
Si coder l'acceptation du glissement est facile
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
procedure TFormDragdrop.ControlListGaucheDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TControlList;
end;
Le problème qui se pose est de retrouver le numéro de l'élément qui va recevoir l'image choisie lors de l'évènement OnDragDrop.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
procedure TFormDragdrop.ControlListGaucheDragDrop(Sender, Source: TObject; X, Y: Integer);
En effet, aucune fonction "visible", du genre "quel est l'élément à la position X,Y ?" n'est disponible .

Réflexe de vieux loup de mer, j'ai d'abord fait une tentative de "piratage" (hacking) du contrôle pour accéder aux fonctions et propriétés privées.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
type
  THackCtrlList = class(TControlList);
Utilisation : THackCtrlList(ControlListGauche). rien que ceci et l'EDI nous affiche tout ce qui est désormais accessible. Malheureusement, les fonctions qui pourraient nous intéresser ne sont toujours pas disponibles . Une descente dans les sources (Ctrl+Clic gauche sur l'unité VCL.ControlList pour passer au mélange Hélium/Oxygène) nous montre que la plupart de ces fonctions (et procédures) sont définies dans la zone privée.
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
private
 ...
    function ItemAtPos(AX, AY: Integer; var ARect: TRect): Integer; // celle-ci est celle qui nous serait utile
..    
     // les diverses fonctions suivantes montrent aussi un intérêt pour les déplacements  
    function GetFirstDrawItemIndex: Integer;
    function GetLastDrawItemIndex: Integer;
    procedure ScrollToItem(AIndex: Integer; ASelect: Boolean; AUpdate: Boolean);
    procedure FindFirstItem;
    procedure FindLastItem;
    procedure FindLeftItem;
    procedure FindRightItem;
    procedure FindUpItem;
    procedure FindDownItem;
    procedure FindPageUpItem;
    procedure FindPageDownItem;
...
Une solution, est de surcharger les diverses fonctions voulues, cependant cela s'est vite avéré fastidieux et pas très probant. De plus le hacking est quand même "inélégant".

Je suis parti sur une autre solution, la création d'un Helper.
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
unit ControlListHelper;

interface

uses WinApi.Windows, WinApi.Messages,
  System.Types, System.Math, System.Classes, System.Generics.Collections,
  Vcl.ControlList;

type
  TControlListHelper = class helper for TCustomControlList
  public
    function _Columns : Integer;
    function _Rows : Integer;
    function _ItemAtPos(X, Y: Integer;
                        iv: TDictionary<Integer, TRect>=nil): Integer;
    function _GetItemRect(AIndex : Integer): TRect;
    procedure _PageDown;
    procedure _PageUp;
    procedure _PageLeft;
    procedure _PageRight;
    procedure _Home;
    procedure _End;
  end;

var VisibleItems : TDictionary<integer,TRect>;

implementation

{ TControlListHelper }


/// <summary>
/// Get the rect of the drawed item on the TControlList
/// </summary>
/// <param name="AIndex">
///   Index of the item
/// </param>
/// <returns>a TRect
/// </returns>
function TControlListHelper._GetItemRect(AIndex : Integer): TRect;
begin
  Result := TRect.Empty;
  case InternalColumnLayout of
    cltSingle:
      begin
        Result.Top := ItemHeight * AIndex;
        Result.Height := ItemHeight;
        Result.Width := IfThen(ItemWidth = 0, Width - 28, ItemWidth);
      end;
    cltMultiTopToBottom:
      begin
        var Cols : integer :=_Columns;
        Result.Left := (AIndex mod Cols) * ItemWidth;
        Result.Top := ((AIndex div Cols) * ItemHeight);
        Result.Height := ItemHeight;
        Result.Width := ItemWidth;
      end;
    cltMultiLeftToRight:
      begin
        var Rows : integer :=_Rows;
        Result.Left := (AIndex div Rows) * ItemWidth;
        Result.Top := (AIndex mod Rows) * ItemHeight;
        Result.Height := ItemHeight;
        Result.Width := ItemWidth;
      end;
  end;
end;

/// <summary>
/// Get index of the TControlList item
/// </summary>
/// <param name="X">
///  X coordinate of the mouse
/// </param>
/// <param name="Y">
///  Y coordinate of the mouse
/// </param>
/// <param name="iv">
///  Items visible on the TControlList
///  a TDictionary<Integer,TRect> to implement during OnDrawItem or AfterDrawItem event
/// </param>
/// <remarks>
///
/// </remarks>
/// <returns>Item index; -1 if invalid
/// </returns>
function TControlListHelper._ItemAtPos(X, Y: Integer;
  iv: TDictionary<Integer, TRect>=nil): Integer;
var
  I: Integer;
  ofHorz, ofVert: Integer;
  ARect: TRect;
begin
  if not Assigned(iv) then iv:=VisibleItems;
  ofHorz := GetScrollPos(Handle, SB_HORZ);
  ofVert := GetScrollPos(Handle, SB_VERT);
  Result := -1;
  for I := 0 to ItemCount - 1 do
  begin
    if iv.TryGetValue(I, ARect) then
    begin
      if ARect.Contains(TPoint.Create(X + ofHorz, Y + ofVert)) then
        exit(I);
    end;
  end;
end;

/// <summary>
/// Get number of columns of the TControlList
/// </summary>
/// <returns>Number of columns
/// </returns>
function TControlListHelper._Columns: Integer;
begin
case InternalColumnLayout of
  cltSingle : result:=1;
  cltMultiTopToBottom : result:=ClientWidth div ItemWidth;
  cltMultiLeftToRight : begin
                           var nr : integer := _Rows;
                           result:=ItemCount div nr;
                           if (ItemCount mod nr)>0 then inc(Result);
                        end;
 end;
end;

/// <summary>
/// Get number of rows of the TControlList
/// </summary>
/// <returns>Number of rows
/// </returns>
function TControlListHelper._Rows: Integer;
begin
result:=1;
case InternalColumnLayout of
  cltSingle : result:=ItemCount;
  cltMultiTopToBottom : begin
                          var nc : integer := _Columns;
                          result:=ItemCount div nc;
                          if (ItemCount mod nc)>0 then inc(result);
                        end;
  cltMultiLeftToRight : result:=ClientHeight div ItemHeight;
 end;
end;

/// <summary>
/// For gesture usage ???
/// </summary>
procedure TControlListHelper._PageDown;
begin
SendMessage(Handle, WM_KEYDOWN, VK_NEXT, 0);
end;

procedure TControlListHelper._PageUp;
begin
SendMessage(Handle, WM_KEYDOWN, VK_PRIOR, 0);
end;

procedure TControlListHelper._PageLeft;
begin
SendMessage(Handle, WM_KEYDOWN, VK_LEFT, 0);
end;

procedure TControlListHelper._PageRight;
begin
SendMessage(Handle, WM_KEYDOWN, VK_RIGHT, 0);
end;

procedure TControlListHelper._Home;
begin
SendMessage(Handle, WM_KEYDOWN, VK_HOME, 0);
end;

procedure TControlListHelper._End;
begin
SendMessage(Handle, WM_KEYDOWN, VK_END, 0);
end;

initialization
  VisibleItems := TDictionary<integer,TRect>.Create;
finalization
  VisibleItems.Free;
end.
Le principe ? Les rectangles des éléments visibles sont mémorisés dans un dictionnaire (soit celui de l'unité, soit un dictionnaire indépendant).
Ce qu'il faut faire pour remplir ce dictionnaire ?
  1. Utiliser OnBeforeDrawItems pour l'effacer VisibleItems.Clear;
  2. Utiliser OnBeforeDrawItem ou OnAfterDrawItem pour inscrire un rectangle dans la collection VisibleItems.AddOrSetValue(AIndex,ControlListGauche._GetItemRect(AIndex))


Obtenir l'index de l'élément sur lequel est l'opération de Drag&drop se termine se fait alors avec le code suivant.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Index:=ControlListGauche._ItemAtPos(X,Y);
À ce stade, je suis sûr que vous avez hâte de voir le code source. Je crois qu'il est temps que je dévoile que tous les programmes de cette série peuvent se retrouver dans un de mes dépôts GitHub, à cette adresse

Envoyer le billet « [Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop » dans le blog Viadeo Envoyer le billet « [Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop » dans le blog Twitter Envoyer le billet « [Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop » dans le blog Google Envoyer le billet « [Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop » dans le blog Facebook Envoyer le billet « [Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop » dans le blog Digg Envoyer le billet « [Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop » dans le blog Delicious Envoyer le billet « [Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop » dans le blog MySpace Envoyer le billet « [Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop » dans le blog Yahoo

Catégories
Programmation , Delphi

Commentaires