[Delphi][VCL] Carnet de Plongées : TControlList - Drag&Drop
par
, 22/04/2021 à 09h06 (1657 Affichages)
Passons à un peu plus sérieux.
Après avoir étudié les évènements spécifiques au TControlList dans les précédents billets
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 :
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.
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 procedure TFormDragdrop.ControlListImagesBeforeDrawItem(AIndex: Integer; ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState); begin VirtualImage3.ImageIndex := AIndex; 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.
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;
*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
Si coder l'acceptation du glissement est facile
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;
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
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;
En effet, aucune fonction "visible", du genre "quel est l'élément à la position X,Y ?" n'est disponible .
Code : Sélectionner tout - Visualiser dans une fenêtre à part procedure TFormDragdrop.ControlListGaucheDragDrop(Sender, Source: TObject; X, Y: Integer);
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.
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 type THackCtrlList = class(TControlList);
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".
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; ...
Je suis parti sur une autre solution, la création d'un Helper.
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).
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.
Ce qu'il faut faire pour remplir ce dictionnaire ?
- Utiliser OnBeforeDrawItems pour l'effacer VisibleItems.Clear;
- 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.
À 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
Code : Sélectionner tout - Visualiser dans une fenêtre à part Index:=ControlListGauche._ItemAtPos(X,Y);