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

Techniques de base

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é !

10 commentaires Donner une note à l'article (5)

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

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 multiplateformes : 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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

Image non disponible

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 :

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

Sous Linux, avec la propriété ReadOnly du TMemo à True, les fichiers ne peuvent être déposés qu'en dehors des limites de la zone d'édition. Avec cette même propriété à False, les fichiers déposés le sont parfois deux fois !

[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 :

 
Sélectionnez
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 :

Image non disponible

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 :

Image non disponible

Voici une suggestion de fichier LFM accompagnant le projet :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

Image non disponible

Le fichier LFM associé sera alors le suivant :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

Image non disponible

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

 
Sélectionnez
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 :

 
Sélectionnez
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 ' + 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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 volumineuses.

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

Image non disponible

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 :

Image non disponible

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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

Image non disponible

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 :

 
Sélectionnez
{ 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 :

 
Sélectionnez
{ 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 :

Image non disponible

Voici les trois fichiers LFM correspondant à ces fiches :

 
Sélectionnez
// 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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 ' + 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 :

 
Sélectionnez
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 ' + 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.

Image non disponible

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.

Merci à Alcatîz pour sa relecture technique et à Claude Leloup pour la correction orthographique.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

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.