Apprendre le glisser-déposer avec Free Pascal / Lazarus 1/3

Techniques de base

Gilles Vasseur

Si les utilisateurs de Lazarus savent sans doute que leur EDI prend en charge le glisser-déposer (ou Drag and drop en anglais), peut-être n'imaginent-ils pas la richesse des possibilités qui s'ouvrent à eux. Le travail qui suit entend montrer la diversité des approches et la souplesse d'une panoplie d'outils finalement peu utilisés, et encore ne prétend-il pas à l'exhaustivité !

- Titre : Apprendre le glisser-déposer avec Free Pascal / Lazarus 1/3

- Auteur : Gilles Vasseur

- Parution : 28 avril 2017

- Public visé :

- Licence : Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright ® 2016 Gilles Vasseur. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Sommaire

- I. Introduction

- II. Glisser-déposer depuis le gestionnaire de fichiers

- III. Glisser-déposer sur une même fenêtre

- III-A. Travail entre deux contrôles

- III-B. Travail entre plusieurs contrôles

- III-C. Travail à l'intérieur d'un contrôle

- III-D. Une combinaison de possibilités

- IV. Glisser-déposer entre les fenêtres d'une application

- V. Conclusion

I - Introduction

Les programmes de test sont présents dans le répertoire exemples accompagnant le présent document.

De nos jours, l'utilisateur d'un ordinateur s'attend à pouvoir déplacer ou dupliquer du contenu à l'écran pour accomplir certaines tâches, simplement en le déposant à tel ou tel endroit, donc sans avoir recours au clavier autrement que pour nuancer sa demande par de rares touches fonctionnelles (le plus souvent, Ctrl, Maj et Alt). C'est ce que je fais en ce moment même avec mon traitement de texte en déplaçant une portion de phrase... Voilà une action très utile et d'autant plus efficace qu'elle est réalisée à l'aide d'une simple souris !

Le glisser-déposer est si pratique et si courant que son absence est vécue comme un manque rédhibitoire. Sans même avoir à évoquer la souris des machines de bureau ou le pavé tactile des ordinateurs portables, les écrans tactiles des smartphones et des tablettes ne sont pas pour rien dans cette exigence. Voilà pourquoi maîtriser cette technique en tant que programmeur est intéressant, voire indispensable.

L'exposé qui suit ira du plus simple au plus complexe, distinguant quatre niveaux de complexité dont seuls les trois premiers seront étudiés :

- le glisser-déposer depuis un gestionnaire de fichiers ;

- le glisser-déposer sur une même fenêtre ;

- le glisser-déposer sur différentes fenêtres d'une même application ;

- le glisser-déposer entre applications.

Le glisser-déposer entre applications est un processus qui sort du cadre de ce tutoriel dans la mesure où les solutions ne sont pas multiplate-formes : par exemple, Windows utilise des objets COM inconnus des autres systèmes d'exploitation. Il n'existe pas à l'heure actuelle de démarche universelle permettant de résoudre ce problème.

II - Glisser-déposer depuis le gestionnaire de fichiers

Le glisser-déposer depuis le gestionnaire de fichiers est très simple puisqu'il ne met en œuvre qu'une propriété et une méthode. En effet, il suffit de donner la valeur True à la propriété AllowDropFiles d'une fiche et de renseigner son gestionnaire d'événements OnDropFiles pour obtenir le fonctionnement escompté.

[Exemple DragAndDrop 01]

En premier lieu, vous devez créer une nouvelle application et placer sur la fiche principale (renommée MainForm) un TMemo (renommé mmoMain) pour les résultats, ainsi qu'un bouton TButton (rebaptisé btnClear) pour nettoyer si besoin l'affichage.

Voici le contenu du fichier LFM de l'exemple :

object MainForm: TMainForm
Left = 240
Height = 338
Top = 196
Width = 823
ActiveControl = btnClear
AllowDropFiles = True // <= c'est le plus important !
Caption = 'Drag and Drop - 01'
ClientHeight = 338
ClientWidth = 823
OnDropFiles = FormDropFiles
Position = poScreenCenter
LCLVersion = '1.6.4.0'
object btnClear: TButton
Left = 733
Height = 25
Top = 304
Width = 75
Caption = 'Nettoyer'
OnClick = btnClearClick
TabOrder = 0
end
object mmoMain: TMemo
Left = 16
Height = 280
Top = 8
Width = 792
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 1
end
end

Comme seul le chemin complet du fichier choisi sera affiché dans la zone d'affichage, le gestionnaire OnDropFiles est lui aussi très simple :

procedure TMainForm.FormDropFiles(Sender: TObject;
const FileNames: array of string);
// *** affichage des fichiers sélectionnés ***
var
Li: Integer;
begin
for Li := 0 to High(FileNames) do
mmoMain.Lines.Add(FileNames[Li]);
end;

La seule difficulté provient du paramètre FileNames qui est un tableau ouvert de chaînes : il peut en effet y avoir plusieurs fichiers traités en même temps, dont le nombre est retourné par la fonction High qui calculera la taille du tableau transmis par le glisser-déposer.

À présent, vous pouvez faire glisser et déposer n'importe quel fichier sur la fiche : en maintenant pressé le bouton gauche de la souris sur le nom ou l'icône du fichier choisi et en faisant glisser le pointeur à l'écran jusqu'à l'application créée, dès que le bouton aura été relâché s'afficheront le chemin complet et le nom de ce fichier :

Vous pouvez aussi sélectionner une série de fichiers en les encadrant, sans relâcher le bouton gauche, et tous les noms et chemins seront reconnus.

Quant au nettoyage de la zone d'affichage, il est obtenu par le gestionnaire du bouton :

procedure TMainForm.btnClearClick(Sender: TObject);
// *** nettoyage du mémo ***
begin
mmoMain.Lines.Clear;
end;

[Exemple DragAndDrop 02]

Une utilisation fréquente de ce mécanisme est d'éditer le contenu des fichiers ainsi déposés. C'est ce que propose de faire succinctement l'exemple suivant en affichant les fichiers Pascal avec mise en évidence de la syntaxe.

Pour cette application, vous aurez placé sur la fiche principale MainForm, un TSynEdit (renommé SynEditMain) et un TSynPasSyn (renommé SynPasSynMain) de l'onglet SynEdit de la palette des composants. Le premier est l'éditeur proprement dit. Il est connecté au second grâce à sa propriété Highlighter : comme son nom l'indique, c'est lui qui sera chargé de la coloration syntaxique.

L'apparence de l'éditeur peut être améliorée en lui faisant occuper toute la surface de la fiche (propriété Align sur alClient) et en autorisant un meilleur rendu de la police de caractères utilisée (sous-propriété Quality de Font à fqClearType, par exemple).

Afin d'obtenir des effets bien visibles, il est de même nécessaire de modifier certaines propriétés de SynPasSynMain: Enabled doit être mise à True pour le rendre actif tandis que la sous-propriété Foreground de nombreux groupes d'attributs (CommentAttri, DirectiveAttri, IdentifierAttri, NumberAttri...) sera personnalisée afin d'obtenir des couleurs de caractères plus contrastées.

Bien entendu, et c'est le cœur du sujet, vous devez rendre possible le glisser-déposer en mettant la propriété AllowDropFiles de MainForm à True et en créant une méthode pour son gestionnaire OnDropFiles.

Le code source associé à la fiche principale est finalement lui aussi d'une grande simplicité. Tout au plus relèvera-t-on la recherche du type de fichier à partir de son extension grâce à la fonction IsPascalSource :

uses
Classes, SysUtils, FileUtil, SynEdit, SynHighlighterMulti, SynHighlighterPas,
Forms, Controls, Graphics, Dialogs;

const
PascalExt: array[1..6] of string = ('.pas','.pp','.p','.lpr','.dpr','.dpk');

type

{ TMainForm }

TMainForm = class(TForm)
SynEditMain: TSynEdit;
SynPasSynMain: TSynPasSyn;
procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
private
{ private declarations }
function IsPascalSource(const AFile: string): Boolean;
public
{ public declarations }
end;

var
MainForm: TMainForm;

implementation

uses
LazFileUtils;

{$R *.lfm}

procedure TMainForm.FormDropFiles(Sender: TObject;
const FileNames: array of String);
// *** chargement si possible ***
begin
if IsPascalSource(FileNames[0]) then
SynEditMain.Lines.LoadFromFile(FileNames[0])
else
MessageDlg('Chargement d''un fichier',
'Le fichier choisi n''est pas un fichier Pascal !', mtError, [mbOK], 0);
end;

function TMainForm.IsPascalSource(const AFile: string): Boolean;
// *** un fichier Pascal ? ***
var
Li: Integer;
begin
if FileIsText(AFile) then
for Li := Low(PascalExt) to High(PascalExt) do
if CompareFileExt(AFile, PascalExt[Li]) = 0 then
Exit(True);
Result := False;
end;

end.

Ici encore, la recherche se fait grâce à un tableau dynamique dont les bornes sont atteintes grâce aux fonctions Low et High. Quant à la fonction CompareFileExt, fournie par l'unité LazFileUtils, elle compare l'extension du fichier en cours avec une extension donnée sans imposer de casse particulière.

L'exécution du programme, si le fichier déposé est de type Pascal, donnera un affichage tel que celui-ci :

Le lecteur intéressé par une application plus aboutie du principe peut consulter le code source de l'application PASInfos.

Notez que rien n'interdit de traiter d'autres fichiers que des textes : ainsi, les images et les sons utilisent couramment ce mécanisme pour leur affichage ou leur exécution.

III - Glisser-déposer sur une même fenêtre

III-A - Travail entre deux contrôles

Le glisser-déposer du contenu d'un contrôle sur une même fenêtre n'est guère plus compliqué que la récupération de données depuis le gestionnaire fichiers puisqu'il ne met en jeu que deux propriétés et autant de gestionnaires d'événements.

Le contrôle dont le contenu doit être autorisé à le faire en vérifiant que sa propriété DragKind est bien à sa valeur par défaut, c'est-à-dire à dkDrag, et que son autre propriété DragMode est positionnée sur la valeur dmAutomatic.

Du côté du contrôle qui va accepter de déposer du contenu, vous autoriserez le lâcher en renseignant le gestionnaire d'OnDragOver et gérerez le lâcher lui-même avec le gestionnaire OnDragDrop.

[Exemple DragAndDrop 03]

Dans sa forme la plus élémentaire, le glisser-déposer peut consister en un changement du libellé d'une étiquette TLabel à partir du libellé d'une autre. Pour cela, sur la fiche principale (toujours baptisée, par souci de commodité, MainForm) d'un nouveau projet, vous déposerez deux TLabel dont les noms seront lblSource et lblTarget et les libellés respectivement « Source » et « Cible ». Vous pouvez aussi modifier la taille de la police de caractères afin de rendre les deux boutons plus visibles :

Voici une suggestion de fichier LFM accompagnant le projet :

object MainForm: TMainForm
Left = 327
Height = 236
Top = 173
Width = 296
Caption = 'Drag and Drop - 03'
ClientHeight = 236
ClientWidth = 296
Position = poScreenCenter
LCLVersion = '1.6.4.0'
object lblSource: TLabel
Left = 88
Height = 45
Top = 40
Width = 97
Caption = 'Source'
DragMode = dmAutomatic
Font.Height = -32
ParentColor = False
ParentFont = False
end
object lblTarget: TLabel
Left = 88
Height = 45
Top = 120
Width = 72
Caption = 'Cible'
Font.Height = -32
ParentColor = False
ParentFont = False
OnDragDrop = lblTargetDragDrop
OnDragOver = lblTargetDragOver
end
end

L'important est de noter que lblSource a bien sa propriété DragMode positionnée sur dmAutomatic et que l'étiquette lblTarget est munie des gestionnaires OnDragOver et OnDragDrop.

Le code à renseigner est encore une fois des plus simples :

procedure TMainForm.lblTargetDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** on accepte le TLabel ***
begin
Accept := (Source is TLabel);
end;

procedure TMainForm.lblTargetDragDrop(Sender, Source: TObject; X, Y: Integer);
// *** on change le libellé ***
begin
(Sender as TLabel).Caption := (Source as TLabel).Caption;
end;

On n'accepte que des TLabel dans OnDragOver et on affecte dans OnDragDrop le libellé de la source (nommée justement Source) au libellé de l'étiquette qui a créé le message (nommée Sender).

Le transtypage, c'est-à-dire la conversion d'un objet d'un certain type en un autre, est obligatoire puisque les gestionnaires ne connaissent que le type le plus générique, à savoir TObject. C'est ainsi que Sender, par exemple, est transformé en TLabel avec as. Ce mécanisme est possible grâce au polymorphisme des objets, une notion capitale de la Programmation Orientée Objet.

À l'exécution, le libellé de lblSource remplace celui de lblTarget si l'utilisateur procède à un glisser-déposer depuis la première étiquette jusqu'à la seconde.

[Exemple DragAndDrop 04]

En général, les contrôles en jeu sont plus nombreux et souvent bidirectionnels : avec le code utilisé dans l'exemple précédent, le libellé de lblTarget est perdu. Bien sûr, vous pourriez, moyennant peu de changements, imaginer un échange des contenus. Par conséquent, l'application proposée impliquera cette fois-ci deux TImage placées chacune dans un TGroupBox.

L'interface proposée aura cet aspect :

Le fichier LFM associé sera alors le suivant :

object MainForm: TMainForm
Left = 256
Height = 261
Top = 173
Width = 446
Caption = 'Drag and Drop - 04'
ClientHeight = 261
ClientWidth = 446
Position = poScreenCenter
LCLVersion = '1.6.4.0'
object GroupBox1: TGroupBox
Left = 24
Height = 208
Top = 31
Width = 184
Caption = 'Image 1'
ClientHeight = 188
ClientWidth = 180
TabOrder = 0
object Image1: TImage
Left = 20
Height = 148
Top = 20
Width = 138
DragMode = dmAutomatic
OnDragDrop = Image1DragDrop
OnDragOver = Image2DragOver
Picture.Data = {
// les données de l'image n'ont pas été reproduites !
}
Stretch = True
end
end
object GroupBox2: TGroupBox
Left = 232
Height = 208
Top = 31
Width = 184
Caption = 'Image 2'
ClientHeight = 188
ClientWidth = 180
TabOrder = 1
object Image2: TImage
Left = 20
Height = 148
Top = 20
Width = 138
DragMode = dmAutomatic
OnDragDrop = Image1DragDrop
OnDragOver = Image2DragOver
Picture.Data = {
// les données de l'image n'ont pas été reproduites !
}
Stretch = True
end
end
end

Chaque image est dotée des valeurs de propriétés et des gestionnaires d'événements permettant la mise en œuvre du glisser-déposer. De plus, sa propriété Stretch a été mise à True pour un affichage réglé sur les dimensions de la zone d'affichage des composants. Il ne reste alors qu'à proposer des gestionnaires partagés par les deux TImage.

L'acceptation d'un lâcher n'est possible que si les contrôles en cause sont les deux images traitées. De même, on refusera une copie d'une image sur elle-même à cause du travail inutile que cela engendrerait :

procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
Accept := (Source <> Sender and ((Source = Image1) or (Source = Image2));
end;

Déposer une image sur l'autre exige de les échanger, ce qui est réalisé grâce à un objet de type TPicture provisoire :

procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** le contrôle est lâché = > on échange les images ***
var
LPct: TPicture;
begin
LPct := TPicture.Create;
try
LPct.Assign((Sender as TImage).Picture);
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
(Source as TImage).Picture.Assign(LPct);
finally
LPct.Free;
end;
end;

À présent, lors de l'exécution de cette petite application, le fait de faire glisser une des deux images vers l'autre et de l'y déposer provoquera leur échange. L'essentiel est de constater que les moyens mis en œuvre par le programmeur sont finalement très limités.

III-B - Travail entre plusieurs contrôles

La multiplication des contrôles en cause complexifie bien évidemment le code, mais sans en modifier les mécanismes fondamentaux. Vous prendrez simplement garde à partager au maximum les méthodes nécessaires afin d'éviter leur multiplication.

[Exemple DragAndDrop 05]

Voici par exemple une application similaire à la précédente si ce n'est que l'utilisateur peut échanger quatre images :

Le code associé est toujours aussi facile à comprendre. Voici le listing complet du code source de la fiche principale de ce nouveau projet :

unit main;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;

type

{ TMainForm }

TMainForm = class(TForm)
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
procedure Image1DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
{%H-}State: TDragState; var Accept: Boolean);
private
{ private declarations }
public
{ public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** survol ***
begin
Accept := (Source is TImage) and (Sender <> Source);
end;

procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** lâcher ***
var
LImg: TImage;
begin
LImg := TImage.Create(nil);
try
LImg.Picture := (Source as TImage).Picture;
(Source as TImage).Picture := (Sender as TImage).Picture;
(Sender as TImage).Picture := LImg.Picture;
finally
LImg.Free;
end;
end;

end.

Dans les deux gestionnaires, vous aurez généralisé le traitement en passant d'une classe particulière à la classe générique TImage. Bien sûr, les quatre TImage ont été rendues aptes au glisser-déposer en mettant leur propriété DragMode à dmAutomatic et en leur faisant partager les deux gestionnaires nécessaires.

Lorsqu'un paramètre d'une méthode n'est pas utilisé, le compilateur émet un avertissement à la compilation. La présence de la directive {%H-} avant ce paramètre apparemment oublié indique qu'il ne s'agit pas d'une étourderie !

III-C - Travail à l'intérieur d'un contrôle

Une possibilité intéressante et assez répandue consiste en le réarrangement d'éléments d'une liste. Le cas le plus classique est celui d'une TListBox ou son équivalent.

[Exemple DragAndDrop 06]

Pour illustrer ce cas, vous créerez une application ne contenant qu'un contrôle de type TListBox. C'est une méthode particulière qui générera, lors de la création de la fiche, des éléments pour l'exemple :

procedure TMainForm.FormCreate(Sender: TObject);
// *** listbox complétée à la création de la fiche ***
var
Li: Integer;
begin
for Li := 1 to 9 do
lbMain.Items.Add('Elément n°' + IntToStr(Li*1000 + Li*100 + Li*10 + Li));
end;

La propriété DragMode de cette liste sera mise à dmAutomatic. Le gestionnaire OnDragOver n'acceptera que la liste elle-même :

procedure TMainForm.lbMainDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** seule la listbox est prise en compte ***
begin
Accept := (Sender = Source);
end;

Le traitement de la liste est un peu complexe, car il s'agit de prendre en compte plusieurs cas, en particulier celui où plusieurs éléments ont été sélectionnés grâce à la touche Maj :

procedure TMainForm.lbMainDragDrop(Sender, Source: TObject; X, Y: Integer);
// *** insertion des éléments sélectionnés ***
var
LSt: TStringList;
Li, LIndex: Integer;
begin
// affichage de la listbox figé pour éviter les scintillements
(Sender as TListBox).Items.BeginUpdate;
try
// index du lâcher
LIndex := (Sender as TListBox).GetIndexAtXY(X, Y);
// liste de travail
LSt := TStringList.Create;
try
// décompte pour éviter les erreurs lors de la suppression d'un élément
for Li := (Sender as TListBox).Count - 1 downto 0 do
begin
// élément sélectionné ?
if (Sender as TListBox).Selected[Li] then
begin
// on l'ajoute à la liste provisoire
LSt.Add((Sender as TListBox).Items[Li]);
// on le supprime de la listbox d'origine
(Sender as TListBox).Items.Delete(Li);
// on réadapte l'index pour éviter les index hors limites
if Li <= LIndex then
Dec(LIndex);
end;
end;
// on insère les éléments déplacés à l'index visé
for Li := 0 to LSt.Count - 1 do
(Sender as TListBox).Items.Insert(LIndex, Lst[Li]);
finally
// libération de la liste de travail
LSt.Free;
end;
finally
// affichage de la lisbox actualisée
(Sender as TListBox).Items.EndUpdate;
end;
end;

Pour que plusieurs éléments d'une liste puissent être sélectionnés simultanément, il faut penser à mettre sa propriété MultiSelect à True.

L'essentiel tient à la méthode GetIndexAtXY de TListBox qui renvoie l'index de l'élément choisi en fonction des coordonnées de la souris au moment du lâcher et à la propriété Selected qui indique si l'élément donné est en surbrillance.

Il ne vous reste alors qu'à insérer les éléments au bon endroit après les avoir effacés de cette même liste, en prenant garde de traiter la liste à rebours pour éviter les erreurs d'indices.

L'utilisation de BeginUpdate et de EndUpdate au sein d'une structure try... finally est fortement conseillée lors de la manipulation de listes : elle évite de désagréables effets de scintillement, surtout si les listes sont conséquentes.

Voici une capture d'écran de cette application en cours d'exécution :

III-D - Une combinaison de possibilités

[Exemple DragAndDrop 07]

L'exemple proposé ci-après va pousser plus avant les techniques vues jusqu'à présent. L'idée est de bâtir une fiche chargée de gérer deux listes dont les éléments pourront être échangés ou réarrangés. En cas d'échange, le clavier et la souris sont autorisés. En cas de remise en ordre, les opérations se feront uniquement avec la souris.

L'interface utilisateur proposée est celle-ci :

Elle comprend par conséquent deux TListBox pour l'affichage des listes, quatre TSpeedButton pour les déplacements via le clavier et un composant TActionList pour la centralisation des commandes.

Voici le fichier LFM correspondant :

object MainForm: TMainForm
Left = 327
Height = 374
Top = 173
Width = 331
Caption = 'Drag and Drop - 07'
ClientHeight = 374
ClientWidth = 331
LCLVersion = '1.6.4.0'
object lbSrc: TListBox
Left = 16
Height = 248
Top = 32
Width = 120
DragMode = dmAutomatic
Items.Strings = (
'essai 1'
'essai 2'
'essai 3'
'essai 41'
'essai 42'
'essai 43'
'essai 44'
'essai 45'
'essai 46'
'essai 47'
'essai 48'
'essai 49'
'essai 50'
'essai 51'
'essai 52'
'essai 53'
'essai 54'
'essai 55'
'essai 56'
)
ItemHeight = 15
ItemIndex = 0
MultiSelect = True
OnDragDrop = lbSrcDragDrop
OnDragOver = lbSrcDragOver
OnEndDrag = lbSrcEndDrag
OnStartDrag = lbSrcStartDrag
TabOrder = 0
end
object lbDst: TListBox
Left = 192
Height = 248
Top = 32
Width = 120
DragMode = dmAutomatic
ItemHeight = 0
MultiSelect = True
OnDragDrop = lbSrcDragDrop
OnDragOver = lbSrcDragOver
OnEndDrag = lbSrcEndDrag
OnStartDrag = lbSrcStartDrag
TabOrder = 1
end
object sbRight: TSpeedButton
Left = 152
Height = 22
Top = 80
Width = 23
Action = ActionRight
Font.Style = [fsBold]
ParentFont = False
end
object sbRightAll: TSpeedButton
Left = 152
Height = 22
Top = 111
Width = 23
Action = ActionRightAll
Font.Style = [fsBold]
ParentFont = False
end
object sbLeft: TSpeedButton
Left = 152
Height = 22
Top = 175
Width = 23
Action = ActionLeft
Font.Style = [fsBold]
ParentFont = False
end
object sbLeftAll: TSpeedButton
Left = 152
Height = 22
Top = 207
Width = 23
Action = ActionLeftAll
Font.Style = [fsBold]
ParentFont = False
end
object sbarMain: TStatusBar
Left = 0
Height = 23
Top = 351
Width = 331
Panels = <>
end
object ActionListMain: TActionList
OnUpdate = ActionListMainUpdate
left = 160
top = 296
object ActionRight: TAction
Caption = '>'
OnExecute = ActionRightExecute
end
object ActionLeft: TAction
Caption = '<'
OnExecute = ActionLeftExecute
end
object ActionRightAll: TAction
Caption = '>>'
OnExecute = ActionRightAllExecute
end
object ActionLeftAll: TAction
Caption = '<<'
OnExecute = ActionLeftAllExecute
end
end
end

Du point de vue du traitement des actions, une première méthode active ou désactive les boutons suivant le contenu des deux listes. Ainsi les boutons seront-ils inactifs si leur action est sans objet :

procedure TMainForm.ActionListMainUpdate(AAction: TBasicAction;
var Handled: Boolean);
// *** mise à jour des boutons ***
begin
sbRight.Enabled := (lbSrc.Items.Count <> 0);
sbRightAll.Enabled := sbRight.Enabled;
sbLeft.Enabled := (lbDst.Items.Count <> 0);
sbLeftAll.Enabled := sbLeft.Enabled;
end;

Les actions correspondant aux boutons sont au nombre de quatre :

procedure TMainForm.ActionRightAllExecute(Sender: TObject);
// *** tout déplacer vers la droite ***
begin
lbSrc.SelectAll;
MoveItems(lbDst.Count, lbSrc, lbDst);
HighlightedItem(lbDst);
end;

procedure TMainForm.ActionLeftExecute(Sender: TObject);
// *** déplacement vers la gauche ***
begin
MoveItems(lbSrc.Count, lbDst, lbSrc);
HighlightedItem(lbSrc);
HighlightedItem(lbDst);
end;

procedure TMainForm.ActionLeftAllExecute(Sender: TObject);
// *** tout déplacer vers la gauche ***
begin
lbDst.SelectAll;
MoveItems(lbSrc.Count, lbDst, lbSrc);
HighlightedItem(lbSrc);
end;

procedure TMainForm.ActionRightExecute(Sender: TObject);
// *** déplacement vers la droite ***
begin
MoveItems(lbDst.Count, lbSrc, lbDst);
HighlightedItem(lbSrc);
HighlightedItem(lbDst);
end;

Comme vous le voyez, elles s'appuient sur deux méthodes outils qui mettent en surbrillance le bon élément après traitement (à travers le focus) et déplacent les éléments voulus entre les listes :

procedure TMainForm.HighlightedItem(List: TListBox);
// *** élément en surbrillance par défaut ***
var
LIndex: Integer;
begin
LIndex := StartOfSelection(List);
if List.Count > 0 then
begin
List.SetFocus;
if LIndex < - 1 then
LIndex := 0
else
if LIndex > List.Count - 1 then
LIndex := List.Count - 1;
List.Selected[LIndex] := True;
end;
end;

procedure TMainForm.MoveItems(Index: Integer; AFromListBox, AToListBox: TListBox);
// *** déplacement d'éléments ***
var
LI: Integer;
begin
if Index < 0 then
Index := 0;
AFromListBox.Items.BeginUpdate;
try
AToListBox.Items.BeginUpdate;
try
for LI := AFromListBox.Count - 1 downto 0 do
if AFromListBox.Selected[LI] then
begin
AToListBox.Items.Insert(Index, AFromListBox.Items[LI]);
AFromListBox.Items.Delete(LI);
end;
finally
AToListBox.Items.EndUpdate;
end;
finally
AFromListBox.Items.EndUpdate;
end;
end;

Toujours pour des raisons d'erreurs de traitement d'éléments supprimés, il est important de modifier une liste en commençant par les éléments aux indices les plus élevés.

Une fois les deux listes avec une propriété DragMode positionnée sur dmAutomatic, l'utilisation du glisser-déposer impose une fois de plus de traiter les cas avec les gestionnaires OnDragOver et OnDragDrop.

Dans le cas présent, voici la solution adoptée :

procedure TMainForm.lbSrcDragDrop(Sender, Source: TObject; X, Y: Integer);
// *** glisser-déposer ***
begin
if (Source = Sender) then
MoveItemsWithinList((Source as TListBox).GetIndexAtXY(X, Y), (Source as TListBox))
else
MoveItems((Sender as TListBox).GetIndexAtXY(X, Y), (Source as TListBox),
(Sender as TListBox));
HighlightedItem(lbSrc);
HighlightedItem(lbDst);
end;

procedure TMainForm.lbSrcDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation du déposer ***
begin
Accept := (Source = lbSrc) or (Source = lbDst);
end;

Si le glisser-déposer concerne une seule liste, vous ferez appel à une méthode définie spécialement pour ce cas :

procedure TMainForm.MoveItemsWithinList(Index: Integer; AListBox: TListBox);
// *** déplacement d'éléments à l'intérieur d'une liste ***
var
LI: Integer;
LStrList: TStringList;
begin
LStrList := TStringList.Create;
try
AListBox.Items.BeginUpdate;
try
for LI := AListBox.Items.Count - 1 downto 0 do
if AListBox.Selected[LI] then
begin
LStrList.Add(AListBox.Items[LI]);
AListBox.Items.Delete(LI);
if LI <= Index then
Dec(Index);
end;
if Index <> -1 then
begin
for LI := 0 to LStrList.Count - 1 do
AListBox.Items.Insert(Index, LStrList[LI]);
end
else
begin
for LI := LStrList.Count - 1 downto 0 do
AListBox.Items.Add(LStrList[LI]);
end;
finally
AListBox.Items.EndUpdate;
end;
finally
LStrList.Free;
end;
end;

Toujours protégés du scintillement par BeginUpdate et EndUpdate, les déplacements doivent aussi tenir compte de l'ordre de réagencement : l'utilisateur s'attend en effet à retrouver les éléments déplacés dans le même ordre, ce qui exige de faire attention à l'ordre des manipulations elles-mêmes.

Une fois ce double mécanisme clavier/souris mis en place, vous obtiendrez des écrans de ce type :

IV - Glisser-déposer entre les fenêtres d'une application

Plus difficile paraît le cas d'éléments déposés depuis d'autres fenêtres de la même application. En effet, comment identifier leur nature et leur origine ? Heureusement, le système de glisser-déposer de Lazarus est fondé sur une classe particulière nommée TDragObject (ou sur sa fille TDragObjectEx) capable de s'adapter à de nombreuses autres situations que celles décrites jusqu'alors.

La différence entre TDragObject et TDragObjectEx est que cette dernière n'a pas besoin d'être libérée après emploi : l'objet créé sera automatiquement détruit à la fin du processus.

Cette fois-ci, au lieu de faire appel à un objet caché, vous allez en créer explicitement un sur mesure afin qu'il soit capable de traiter les données en jeu. Heureusement, pour ce faire, la simplicité est encore de mise.

Voici par exemple à quoi ressemble une classe dérivée manipulant des listes de chaînes de caractères :

{ TMyDragObject }

TMyDragObject = class(TDragObjectEx)
strict private
fItems: TStrings;
procedure SetItems(const AValue: TStrings);
public
constructor Create(AControl: TControl); override;
destructor Destroy; override;
property Items: TStrings read fItems write SetItems;
end;

L'implémentation est tout aussi accessible puisqu'il s'agit avant tout de créer et de détruire des instances tout en permettant la modification d'une propriété définissant les éléments manipulés :

{ TMyDragObject }

procedure TMyDragObject.SetItems(const AValue: TStrings);
// *** éléments à déplacer ***
begin
if fItems = AValue then
Exit;
fItems.Assign(AValue);
end;

constructor TMyDragObject.Create(AControl: TControl);
// *** création du déplacement ***
begin
inherited Create(AControl);
fItems := TStringList.Create;
end;

destructor TMyDragObject.Destroy;
// *** destruction du déplacement ***
begin
fItems.Free;
inherited Destroy;
end;

Dorénavant, votre système de glisser-déposer devra être légèrement modifié pour fonctionner y compris à partir d'autres fenêtres de la même application.

[Exemple DragAndDrop 08]

Pour que tout cela devienne plus clair, vous allez créer une nouvelle application comprenant trois fenêtres munies elles-mêmes d'un contrôle chacune. Sur la fiche principale (baptisée MainForm) figurera un TMemo qui accueillera les résultats des glisser-déposer. Sur une fiche baptisée lbForm figurera une TListBox nommée lbListBoxForm alors que sur la dernière fiche baptisée edtForm aura été posée un TEdit nommé edtEdtForm.

L'interface graphique proposée est celle-ci :

Voici les trois fichiers LFM correspondant à ces fiches :

// fiche principale

object MainForm: TMainForm
Left = 506
Height = 350
Top = 202
Width = 428
Caption = 'Drag and Drop - 07'
ClientHeight = 350
ClientWidth = 428
LCLVersion = '1.6.4.0'
object mmoMain: TMemo
Left = 16
Height = 256
Top = 8
Width = 392
DragMode = dmAutomatic
OnDragDrop = mmoMainDragDrop
OnDragOver = mmoMainDragOver
OnEndDrag = mmoMainEndDrag
OnStartDrag = mmoMainStartDrag
ScrollBars = ssAutoBoth
TabOrder = 0
end
object btnClear: TButton
Left = 336
Height = 25
Top = 296
Width = 75
Caption = 'Nettoyer'
OnClick = btnClearClick
TabOrder = 1
end
end

// fiche de la TListBox

object ListBoxForm: TListBoxForm
Left = 951
Height = 240
Top = 202
Width = 320
BorderIcons = [biMinimize]
BorderStyle = bsSingle
Caption = 'Drag and Drop - 07'
ClientHeight = 240
ClientWidth = 320
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.6.4.0'
Visible = True
object lbListBoxForm: TListBox
Left = 56
Height = 176
Top = 16
Width = 208
DragMode = dmAutomatic
ItemHeight = 0
MultiSelect = True
OnDragDrop = lbListBoxFormDragDrop
OnDragOver = lbListBoxFormDragOver
OnEndDrag = lbListBoxFormEndDrag
OnStartDrag = lbListBoxFormStartDrag
TabOrder = 0
end
end

// fiche du TEdit

object ListBoxForm: TListBoxForm
Left = 951
Height = 240
Top = 202
Width = 320
BorderIcons = [biMinimize]
BorderStyle = bsSingle
Caption = 'Drag and Drop - 07'
ClientHeight = 240
ClientWidth = 320
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.6.4.0'
Visible = True
object lbListBoxForm: TListBox
Left = 56
Height = 176
Top = 16
Width = 208
DragMode = dmAutomatic
ItemHeight = 0
MultiSelect = True
OnDragDrop = lbListBoxFormDragDrop
OnDragOver = lbListBoxFormDragOver
OnEndDrag = lbListBoxFormEndDrag
OnStartDrag = lbListBoxFormStartDrag
TabOrder = 0
end
end

Du point de vue du fonctionnement de l'ensemble, la fiche la plus simple est certainement edtForm. Outre la propriété DragMode du TEdit que vous aurez mise à dmAutomatic, vous accomplirez les tâches habituelles via les gestionnaires OnDragOver et OnDragDrop, mais aussi gérerez l'objet de type TMyDragObject.

Le détail des opérations est présenté ci-après :

procedure TEditForm.FormCreate(Sender: TObject);
// *** création et remplissage de la fiche ***
begin
edtEdtForm.Text := 'Coucou';
end;

procedure TEditForm.edtEdtFormStartDrag(Sender: TObject;
var DragObject: TDragObject);
// *** début de déplacement ***
begin
MyDragObj := TMyDragObject.Create(edtEdtForm);
if edtEdtForm.Text <> '' then
MyDragObj.Items.Add(edtEdtForm.Text);
DragObject := MyDragObj;
end;

procedure TEditForm.edtEdtFormEndDrag(Sender, Target: TObject; X, Y: Integer);
// *** nettoyage si déplacement effectué ***
begin
if (Target <> Sender) and MyDragObj.Dropped then
edtEdtForm.Text := '';
MyDragObj.Free;
end;

procedure TEditForm.edtEdtFormDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation d'un déplacement ***
begin
Accept := (Source is TMyDragObject) and ((Source as TMyDragObject).Items.Count = 1);
end;

procedure TEditForm.edtEdtFormDragDrop(Sender, Source: TObject; X, Y: Integer);
// *** déplacement effectué ***
begin
edtEdtForm.Text := (Source as TMyDragObject).Items[0];
end;

Vous noterez que l'éditeur n'accepte que des objets de type TMyDragObject tels qu'ils ont été définis précédemment : l'éditeur n'a par conséquent pas à savoir la nature exacte du contrôle à l'origine du glisser-déposer, ce qui correspond au but recherché ! De plus, le même composant TEdit n'accepte que des chaînes simples et non une liste : c'est ce qui est indiqué dans le gestionnaire OnDragOver. Enfin, si la cible a été atteinte, une information fournie par la méthode Dropped de l'objet MyDragObject au sein du gestionnaire OnEndDrag, la zone d'édition est mise à zéro.

Le traitement particulier du glisser-déposer est initialisé grâce au gestionnaire OnStartDrag qui prend comme paramètre variable DragObject de type TDragObject. Si ce paramètre n'est pas modifié, le système créera lui-même un objet de type TDragObject par défaut : c'est ce qui s'est produit pour tous les exemples précédents.

La fiche qui contient la TListBox n'apporte pas de surprises dans son implémentation :

procedure TListBoxForm.FormCreate(Sender: TObject);
// *** création et remplissage de la fiche ***
var
Li: Integer;
begin
for Li := 0 to 9 do
lbListBoxForm.Items.Add('Elément n°' + IntToStr(Li));
LSt := TStringList.Create;
end;

procedure TListBoxForm.FormDestroy(Sender: TObject);
// *** destruction de la fiche ***
begin
LSt.Free;
end;

procedure TListBoxForm.lbListBoxFormDragDrop(Sender, Source: TObject; X,
Y: Integer);
// *** déplacement des objets ***
var
Li: Integer;
begin
MyDragObj := (Source as TMyDragObject);
for Li := 0 to MyDragObj.Items.Count - 1 do
lbListBoxForm.Items.Add(MyDragObj.Items[Li]);
end;

procedure TListBoxForm.lbListBoxFormDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
// *** acceptation des déplacements ***
begin
Accept := (Source is TMyDragObject) and
not ((Source as TMyDragObject).Control is TListBox);
end;

procedure TListBoxForm.lbListBoxFormEndDrag(Sender, Target: TObject; X,
Y: Integer);
// *** suppression des éléments après déplacement ***
var
Ls: string;
begin
try
if (Sender <> Target) and MyDragObj.Dropped then
begin
lbListBoxForm.Items.BeginUpdate;
try
for Ls in LSt do
lbListBoxForm.Items.Delete(lbListBoxForm.Items.IndexOf(Ls));
finally
lbListBoxForm.Items.EndUpdate;
end;
end;
finally
MyDragObj.Free;
end;
end;

procedure TListBoxForm.lbListBoxFormStartDrag(Sender: TObject;
var DragObject: TDragObject);
// *** début de déplacement ***
var
Li: Integer;
begin
LSt.Clear;
MyDragObj := TMyDragObject.Create(lbListBoxForm);
for Li := 0 to lbListBoxForm.Count - 1 do
if lbListBoxForm.Selected[Li] then
begin
MyDragObj.Items.Add(lbListBoxForm.Items[Li]);
LSt.Add(lbListBoxForm.Items[Li]);
end;
DragObject := MyDragObj;
end;

Comme pour la fiche précédente, vous prendrez garde de ne pas accepter dans le gestionnaire OnDragOver de copies d'éléments du composant sur lui-même et de ne supprimer dans le gestionnaire d'OnEndDrag les éléments que s'ils ont été vraiment copiés ailleurs.

Une difficulté supplémentaire vient de ce qu'il vous faut construire la liste des éléments à déplacer en vous servant de la propriété Selected associée à chaque élément de la liste initiale.

Enfin, la fiche principale ne requiert pas d'attention particulière :

procedure TMainForm.btnClearClick(Sender: TObject);
// *** nettoyage sur clic ***
begin
Clear;
end;

procedure TMainForm.mmoMainDragDrop(Sender, Source: TObject; X, Y: Integer);
// *** déplacement effectué ***
var
Li: Integer;
begin
MyDragObj := (Source as TMyDragObject);
for Li := 0 to MyDragObj.Items.Count - 1 do
mmoMain.Lines.Add(MyDragObj.Items[Li]);
end;

procedure TMainForm.mmoMainDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation du déplacement ***
begin
Accept := (Source is TMyDragObject) and
not ((Source as TMyDragObject).Control is TMemo);
end;

procedure TMainForm.mmoMainEndDrag(Sender, Target: TObject; X, Y: Integer);
// *** fin de déplacement ***
begin
if MyDragObj.Dropped then
mmoMain.Lines.Clear;
MyDragObj.Free;
end;

procedure TMainForm.mmoMainStartDrag(Sender: TObject;
var DragObject: TDragObject);
// *** début de déplacement ***
var
Ls: string;
begin
MyDragObj := TMyDragObject.Create(mmoMain);
for Ls in mmoMain.Lines do
MyDragObj.Items.Add(Ls);
DragObject := MyDragObj;
end;

procedure TMainForm.Clear;
// *** nettoyage des contrôles ***
var
Li: Integer;
begin
mmoMain.Lines.Clear;
edtform.EditForm.edtEdtForm.Text := 'Coucou';
lbform.ListBoxForm.lbListBoxForm.Items.Clear;
for Li := 0 to 9 do
lbform.ListBoxForm.lbListBoxForm.Items.Add('Elément n°' + IntToStr(Li));
end;

Les mêmes principes que ceux rencontrés jusqu'à maintenant gouvernent sa structure et son implémentation. La réelle nouveauté est qu'elle abrite dorénavant la déclaration et l'implémentation de la classe TMyDragObject.

Finalement, ce qui ressort de cet exercice est que les méthodes et les gestionnaires mis en œuvre sont un peu plus nombreux que dans les cas plus simples étudiés jusqu'alors. L'essentiel tient autour du descendant de TDragObject tel qu'il est créé pour manipuler les données particulières du problème à résoudre. Vous noterez que des perspectives s'ouvrent avec cette procédure plus lourde, mais aussi plus souple : en n'ayant pas à identifier formellement le pourvoyeur de données, les contrôles s'affranchissent de barrières, ouvrant ainsi un champ de possibilités à explorer !

V - Conclusion

Avec ce tutoriel, vous aurez appris à utiliser le glisser-déposer (Drag and Drop) dans plusieurs cas de figure :

- depuis un gestionnaire de fichiers ;

- entre plusieurs contrôles d'une même fiche ;

- à l'intérieur même d'un contrôle ;

- entre les fenêtres d'une même application.

Une suite au travail présenté consistera à s'ouvrir aux possibilités de personnalisation de ce mécanisme si utile.