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

Personnalisation

Après avoir étudié les techniques de base à mettre en œuvre pour le glisser-déposer avec Free Pascal et Lazarus, il s'agit à présent de personnaliser son apparence suivant les besoins précis d'une application.

Commentez 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.

Vous savez utiliser le glisser-déposer au sein d'un contrôle, entre des contrôles et même entre les fenêtres d'une même application. Cependant, vous considérez que le mécanisme mis à votre disposition ne correspond pas tout à fait à vos attentes : vous aimeriez une autre icône lors du déplacement, ou utiliser le bouton droit de la souris, ou encore ne l'embrayer qu'après un mouvement significatif de cette même souris… Qu'à cela ne tienne : Lazarus sait répondre à ce genre de situations !

L'exposé qui suit vous aidera à personnaliser vos applications qui utiliseront le glisser-déposer. Il vous proposera des méthodes souvent utiles parmi lesquelles vous choisirez celles qui vous paraîtront les plus pertinentes aux problèmes réels posés.

II. Petits arrangements entre amis

II-A. Utiliser les propriétés de l'application

Avant de se pencher sur l'échange d'informations à partir de contrôles, il peut être utile de savoir que l'accès à des fichiers depuis un gestionnaire de fichiers est susceptible d'être centralisé grâce au composant TApplicationProperties issu du volet « Additional » des composants. En effet, ce composant non visuel a été créé afin de faciliter la gestion de différents paramètres de l'application qui l'utilise : il fournit en particulier la possibilité d'écrire un gestionnaire OnDropFiles qui sera appliqué à toutes les fenêtres qui auront leur propriété AllowDropFiles à True, donc sans avoir besoin d'être dupliqué.

[Exemple DragAndDrop 09]

Pour le tester, vous allez créer une application qui va afficher les fichiers de type Pascal comme vous l'aviez déjà fait dans le tutoriel précédent. À la différence de cet exemple, les fichiers pourront être glissés aussi bien sur la fiche principale qui abritera l'éditeur que sur une seconde fenêtre apparemment sans rôle : en effet, elle n'aura que sa propriété AllowDropFiles passée à True, et rien d'autre !

Voici l'interface utilisateur proposée :

Image non disponible

La fiche principale (MainForm) comprend un composant TSynEdit (baptisé SynEditMain) pour l'édition et son compagnon de coloration syntaxique TSynPasSyn (SynPasSynMain). L'éditeur a sa propriété Align passée à alClient afin d'occuper tout l'espace de la fiche. Bien sûr, la propriété AllowDropFiles de cette même fiche est à True.

Surtout, vous devez ajouter un composant TApplicationProperties que vous renommerez en ApplicationPropertiesMain. Depuis l'onglet « Événements » de l'inspecteur d'objets positionné sur ce composant, vous créerez simplement un gestionnaire OnDropFiles ainsi :

 
Sélectionnez
procedure TMainForm.ApplicationPropertiesMainDropFiles(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;

Vous reconnaîtrez le gestionnaire déjà rédigé pour l'ancien exemple, mais attribué cette fois-ci au composant de centralisation et non à la fiche elle-même.

La seconde fiche (SecondForm) a une bordure (BorderStyle) positionnée en bsDialog et sera affichée sans icône : toutes les sous-propriétés de BorderIcons sont à False. Il ne s'agit que d'un choix arbitraire pour une présentation plus soignée et qui n'influe en rien le comportement du glisser-déposer. En revanche, cette fiche doit impérativement elle aussi avoir sa propriété AllowDropFiles à True. L'unité afférente ne comprendra aucun code autre que celui créé automatiquement par Lazarus, même pas une référence à la fiche principale !

Le fichier LFM qui lui correspond aura cette allure :

 
Sélectionnez
object SecondForm: TSecondForm
  Left = 826
  Height = 84
  Top = 141
  Width = 217
  AllowDropFiles = True
  BorderIcons = []
  BorderStyle = bsDialog
  Caption = 'J''aime Pascal !'
  LCLVersion = '1.6.4.0'
end

Dans la fiche principale, vous commanderez l'affichage de la seconde fiche via le gestionnaire OnShow, par exemple, sans oublier de définir la méthode IsPascalSource pour la validation de la prise en compte des fichiers déposés.

Le code source de la fiche principale ressemblera finalement à ceci :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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)
    ApplicationPropertiesMain: TApplicationProperties;
    SynEditMain: TSynEdit;
    SynPasSynMain: TSynPasSyn;
    procedure ApplicationPropertiesMainDropFiles(Sender: TObject;
      const FileNames: array of String);
    procedure FormShow(Sender: TObject);
  private
    { private declarations }
    function IsPascalSource(const AFile: string): Boolean;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  LazFileUtils, second;

{$R *.lfm}


procedure TMainForm.ApplicationPropertiesMainDropFiles(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;

procedure TMainForm.FormShow(Sender: TObject);
// *** affichage de la seconde fiche ***
begin
  SecondForm.Show;
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.

Dorénavant, à l'exécution de cette application, les fichiers de type Pascal seront listés sur la fenêtre principale, qu'ils aient indifféremment été déposés sur cette fiche ou sur sa petite sœur squelettique !

II-B. Choisir le bouton actif de la souris

Revenant au cas plus riche du glisser-déposer avec des contrôles d'une fiche, vous allez à présent apprendre à personnaliser certains aspects de ce mécanisme. Pour commencer, vous allez décider quelle action sur la souris le déclenchera.

[Exemple DragAndDrop 10]

Déjà, vous allez reprendre l'échange de deux images selon l'interface utilisateur suivante :

Image non disponible

Dans deux TGroupBox, vous aurez placé une TImage dont la propriété Stretch aura été mise à True pour circonscrire l'image contenue.

Les gestionnaires d'événements OnDragOver et OnDragDrop seront ceux utilisés précédemment :

 
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 = Image1) or (Source = Image2);
end;

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;

Vous prendrez soin de les connecter aux deux images afin d'autoriser les échanges.

En revanche, vous ne mettrez pas la propriété DragMode des TImage à dmAutomatic, mais vous la laisserez à dmManual. Ainsi vous garderez un véritable contrôle du mécanisme de glisser-déposer.

Comme premier exemple de ce contrôle amélioré, vous pouvez décider de lancer le glisser lorsque l'utilisateur aura maintenu pressé le bouton droit de la souris. C'est par conséquent au nouveau gestionnaire OnMouseDown que vous allez faire appel en l'associant encore une fois aux deux TImage :

 
Sélectionnez
procedure TMainForm.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
// *** lancement du glisser ? ***
begin
  if (Sender is TImage) and (Button = mbRight) then
    (Sender as TImage).BeginDrag(True);
end;

Comme le glisser a été rendu manuel, il faut explicitement le déclencher : c'est l'objectif de la méthode BeginDrag dont le paramètre est mis à True afin de lancer directement le mécanisme.

Les tests au sein du gestionnaire sont facilement compréhensibles : s'il s'agit d'une image et que le bouton droit de la souris est pressé, alors on doit lancer le glisser lié à cette image.

II-C. Prévoir un seuil avant le déclenchement

Toujours dans le même esprit de personnalisation, il peut être utile de ne passer en mode glisser qu'après un certain déplacement de la souris. Par exemple, au sein d'un TEdit, tout mouvement ne signifie pas forcément un glisser-déposer : l'utilisateur doit aussi pouvoir saisir des données !

Pour ce faire, la méthode BeginDrag cache un second paramètre baptisé Threhold : il définit le nombre de pixels que doit parcourir la souris pour que le mouvement soit considéré comme un glisser-déposer. S'il n'apparaissait pas dans l'exemple précédent, c'est qu'il a une valeur par défaut de -1 qui correspond à une valeur définie en dur de 5 pixels avant déclenchement.

En reprenant le système d'échange d'images, vous aurez peu de choses à modifier pour tester cette nouvelle possibilité.

[Exemple DragAndDrop 11]

En fait, après avoir ajouté un composant TSpinEdit (baptisé seThrehold) à la fiche principale, deux possibilités s'offriront à vous :

  • passer le paramètre de BeginDrag à False puis associer un gestionnaire OnChange au TSpinEdit pour modifier grâce à lui la propriété DragThrehold de l'objet global Mouse qui gouverne la souris ;
  • comme indiqué en premier lieu, fournir directement la valeur du paramètre caché de BeginDrag à partir de celle du TSpinEdit.

Ce sont ces options qu'illustre le listing suivant :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, ComCtrls, Spin;

type

  { TMainForm }

  TMainForm = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    lblThrehold: TLabel;
    seThrehold: TSpinEdit;
    procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
    procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
      {%H-}State: TDragState; var Accept: Boolean);
    procedure seThreholdChange(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

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

procedure TMainForm.seThreholdChange(Sender: TObject);
// *** seuil avant déplacement ***
begin
  Mouse.DragThreshold := seThrehold.Value; // à commenter (option 2)
end;

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;

procedure TMainForm.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
// *** lancement du glisser ? ***
begin
  if (Sender is TImage) and (Button = mbRight) then
    (Sender as TImage).BeginDrag(False); // changement !
    // (Sender as TImage).BeginDrag(False, seThrehold.Value); // autre possibilité
end;

end.

Plus le seuil de déclenchement sera élevé, plus il sera facile de mesurer son effet. Voici un instantané pris de l'application en cours d'exécution :

Image non disponible

Parmi les propriétés de la classe TMouse, DragImmediate offre encore une variante : si elle vaut False, elle devient l'équivalent du paramètre de BeginDrag à False lui aussi. Ainsi le déclenchement sera-t-il aussi différé tant que la longueur Threhold ne sera pas franchie avec la souris.

[Exemple DragAndDrop 12]

Cette option ne modifie guère l'exemple précédent : vous ajouterez seulement une TCheckBox (nommée cbDragImmediate) pour associer grâce à un gestionnaire OnChange une valeur booléenne à la propriété DragImmediate de l'objet Mouse.

Voici le code source de l'unité de la fiche principale :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMainForm }

  TMainForm = class(TForm)
    cbDragImmediate: TCheckBox;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    lblThrehold: TLabel;
    seThrehold: TSpinEdit;
    procedure cbDragImmediateChange(Sender: TObject);
    procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
    procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
      {%H-}State: TDragState; var Accept: Boolean);
    procedure seThreholdChange(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

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

procedure TMainForm.seThreholdChange(Sender: TObject);
// *** seuil avant déplacement ***
begin
  Mouse.DragThreshold := seThrehold.Value;
end;

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;

procedure TMainForm.cbDragImmediateChange(Sender: TObject);
// *** déplacement immédiat ? ***
begin
  Mouse.DragImmediate := cbDragImmediate.Checked;
end;

end.

L'ensemble est bien plus cohérent puisque toute la personnalisation passe par l'objet Mouse à travers deux de ses propriétés, à savoir DragImmediate et DragThrehold. Vous pourrez toujours préférer utiliser la méthode BeginDrag en adaptant ses deux paramètres à vos besoins.

À l'exécution, en dehors de l'action introduite par le nouveau composant, rien ne change si ce n'est le contrôle de l'immédiateté du glisser-déposer :

Image non disponible

II-D. Forcer le glisser-déposer

Toujours dans le domaine des méthodes fort utiles, il en est une qui permet de simuler un glisser-déposer. Associée à un contrôle autorisant le glisser-déposer, cette méthode prend pour paramètres l'objet à exploiter pour déposer et deux entiers pour indiquer à quelle position doit aboutir le dépôt.

[Exemple DragAndDrop 13]

Afin de mieux vous rendre compte quelle souplesse nouvelle apporte cette méthode, vous allez créer une nouvelle application qui apparaît comme une version simplifiée des précédentes. En voici l'interface utilisateur :

Image non disponible

L'image sera simplement recopiée dans l'espace vide juxtaposé. Pour cela, vous passerez à dmAutomatic la propriété DragMode de Image1, puis vous saisirez le code suivant :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMainForm }

  TMainForm = class(TForm)
    btnCopy: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    procedure btnCopyClick(Sender: TObject);
    procedure Image2DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }



procedure TMainForm.btnCopyClick(Sender: TObject);
// *** glisser déposer forcé ***
begin
  Image2.DragDrop(Image1, 0, 0);
end;

procedure TMainForm.Image2DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** lâcher sur l'image 2 ***
begin
  (Sender as TImage).Picture.Assign((Source as TImage).Picture);
end;

end.

Si le gestionnaire OnDragDrop est celui conçu habituellement, vous voyez qu'un clic sur le bouton « Copier » exécute la méthode DragDrop liée à Image2 (donc la destination) à partir de la source indiquée en paramètre (ici, Image1). Il est ainsi possible de court-circuiter le glisser-déposer tout en utilisant le même gestionnaire OnDragDrop.

II-E. Savoir si un glisser-déposer est en cours

Parfois, il est nécessaire de savoir si une opération de glisser-déposer est en cours. Imaginez par exemple certaines commandes à activer ou désactiver. Encore une fois, une simple méthode associée aux contrôles et renvoyant un booléen fera l'affaire : il s'agit de Dragging.

[Exemple DragAndDrop 14]

Toujours à partir des deux images à permuter, vous pouvez enrichir l'application de test en adaptant le statut d'un bouton au glisser-déposer éventuellement en cours. Vous n'avez qu'à ajouter un TButton (renommé btnDummy) et un composant non visuel TActionList (renommé ActionList) pour la gestion des actions.

À partir de ce dernier, vous créerez une nouvelle action baptisée ActionButton, ainsi que deux gestionnaires liés à cette dernière : OnExecute et OnUpdate.

Le code de ces gestionnaires ne pose pas de problèmes particuliers :

 
Sélectionnez
procedure TMainForm.ActionButtonUpdate(Sender: TObject);
// *** désactivation si déplacement en cours ***
begin
  btnDummy.Enabled := not (Image1.Dragging or Image2.Dragging);
end;

procedure TMainForm.ActionButtonExecute(Sender: TObject);
// *** action liée au clic sur le bouton ***
begin
  MessageDlg('', 'Le bouton a été cliqué !', mtInformation, [mbOK], 0);
end;

Comme annoncé, il s'agit de mettre à l'épreuve la méthode Dragging : le bouton ne sera activé que si aucune des images n'est en cours de glisser-déposer. Quant au clic sur le bouton, s'il est actif, il provoquera l'affichage d'une boîte de dialogue rudimentaire.

Pour le reste, vous retrouverez la machinerie qui vous est dorénavant familière.

Le code source de la fiche principale est fourni ci-après :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMainForm }

  TMainForm = class(TForm)
    ActionButton: TAction;
    ActionList: TActionList;
    btnDummy: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    procedure ActionButtonExecute(Sender: TObject);
    procedure ActionButtonUpdate(Sender: TObject);
    procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
    procedure Image2DragOver(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.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
  Accept := (Source = Image1) or (Source = Image2);
end;

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;

procedure TMainForm.ActionButtonUpdate(Sender: TObject);
// *** désactivation si déplacement en cours ***
begin
  btnDummy.Enabled := not (Image1.Dragging or Image2.Dragging);
end;

procedure TMainForm.ActionButtonExecute(Sender: TObject);
// *** action liée au clic sur le bouton ***
begin
  MessageDlg('', 'Le bouton a été cliqué !', mtInformation, [mbOK], 0);
end;

end.

L'application en action fournira ce genre de copie d'écran sur laquelle vous remarquerez le bouton désactivé puisqu'une opération de glisser-déposer est en cours :

Image non disponible

[Exemple DragAndDrop 15]

Plus généralement, si votre fiche active a besoin de savoir si une opération de glisser-déposer est en cours, il vous faudra parcourir les contrôles présents et étudier la valeur retournée par la fonction Dragging  qui leur correspond.

Voici une méthode applicable à cette fin :

 
Sélectionnez
function TMainForm.IsDragging: Boolean;
// *** une opération de glisser-déplacer est-elle en cours ? ***
var
  Li: Integer;
begin
  Result := False;
  for Li := 0 to ComponentCount - 1 do
    if (Components[Li] is TControl) and (Components[Li] as TControl).Dragging then
    begin
      Result := True;
      Break;
    end;
end;

La liste des composants de la fiche est parcourue. Si le composant en cours est un descendant de TControl , on vérifie grâce à sa méthode Dragging  s'il est en cours de glisser-déposer. La boucle est interrompue dès le premier test positif.

Du coup, l'activité du bouton de l'exemple précédent change un peu de forme :

 
Sélectionnez
procedure TMainForm.ActionButtonUpdate(Sender: TObject);
// *** désactivation si déplacement en cours ***
begin
  btnDummy.Enabled :=  not IsDragging;
end;

L'avantage de cette façon de faire est qu'elle est bien plus générale. Il faudra cependant faire attention à ne pas ralentir l'application avec un trop grand nombre de composants présents.

II-F. Identifier une cible

Une autre fonctionnalité peut s'avérer nécessaire : identifier la cible potentielle d'un glisser-déposer. Pour cela, une fois n'est pas coutume, il est suggéré d'utiliser une fonction globale : FindDropTarget .

Cette fonction de l'unité Controls identifie le contrôle présent à une position donnée de l'application et renvoie un résultat de type TControl  (ou nil si aucun contrôle n'est présent sous le curseur). En fait, il ne s'agit que d'un double de la fonction FindControlAtPosition :

 
Sélectionnez
function FindDragTarget(const Position: TPoint; AllowDisabled: Boolean): TControl;
function FindControlAtPosition(const Position: TPoint; AllowDisabled: Boolean): TControl;

Les coordonnées fournies le sont relativement à l'écran. Le second paramètre n'est pour le moment pas pris en compte et devrait toujours être à False.

[Exemple DragAndDrop 16]

Même si elle est plutôt limitée, cette fonction peut rendre quelques services. Voici par exemple son intervention dans l'application d'échanges d'images :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMainForm }

  TMainForm = class(TForm)
    ApplicationProperties: TApplicationProperties;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    lblOver: TLabel;
    procedure ApplicationPropertiesIdle(Sender: TObject; var {%H-}Done: Boolean);
    procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
    procedure Image2DragOver(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.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
  Accept := (Source = Image1) or (Source = Image2);
end;

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;

procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean
  );
// *** contrôle survolé ***
var
  LControl: TControl;
begin
  LControl := FindDragTarget(Mouse.CursorPos, False);
  if LControl <> nil then
    LblOver.Caption := LControl.ClassName;
end;

end.

La mise en œuvre de la fonction FindDropTarget peut se faire, comme dans l'exemple proposé, grâce au gestionnaire OnIdle du composant TApplicationProperties qui gère les propriétés globales d'une application. Plus exactement, ce gestionnaire effectue des tâches lorsque l'application n'a rien à faire. On voit qu'ici, si un contrôle est repéré à la position de la souris, son nom de classe est affecté au libellé d'une étiquette baptisée lblOver.

II-G. Contrôler l'état du glisser-déposer

Pour clore ce tour d'horizon des outils de personnalisation offerts par Lazarus, vous allez vous servir d'un paramètre jusque là inexploité du gestionnaire de OnDragOver. En effet, State vérifie l'état de la souris survolant un contrôle prêt à accepter le dépôt de données. Il devient possible de distinguer l'entrée de la souris, son survol et sa sortie du contrôle visé, d'où des réactions envisageables comme des messages d'alerte, des animations, des calculs, etc.

Voici les trois états définis :

 
Sélectionnez
TDragState = (dsDragEnter, dsDragLeave, dsDragMove);

[Exemple DragAndDrop 17]

Dans l'exemple proposé, vous vous contenterez, toujours à partir de la trame de deux images à échanger, de modifier le libellé d'un TLabel baptisé lblState.

Le code source ne pose a priori aucun problème particulier :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMainForm }

  TMainForm = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    lblState: TLabel;
    procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
    procedure Image2DragOver(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.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
  Accept := (Source = Image1) or (Source = Image2);
  case State of
    dsDragEnter: lblState.Caption := Format('%s entre sur %s', [(Source as TImage).Name,
      (Sender as TImage).Name]);
    dsDragLeave: lblState.Caption := Format('%s quitte %s', [(Source as TImage).Name,
      (Sender as TImage).Name]);
    dsDragMove: lblState.Caption := Format('%s se déplace sur %s', [(Source as TImage).Name,
      (Sender as TImage).Name]);
  end;
end;

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;

end.

Lors de l'exécution, vous constaterez que le paramètre State renvoie correctement les trois états dont il est supposé rendre compte :

Image non disponible

Si vous souhaitez aller plus loin dans la mesure des paramètres du glisser-déposer, vous n'aurez qu'à utiliser les paramètres X et Y des gestionnaires OnDragOver et OnDragDrop. Rien n'empêche de travailler au pixel près et de réagir différemment suivant les coordonnées exactes du point de dépôt.

[Exemple DragAndDrop 18]

Si vous reprenez l'exemple précédent, il suffit de lui adjoindre deux TLabel pour relever les coordonnées renvoyées par les gestionnaires cités. Le code source de l'unité principale n'est donc enrichi que de deux lignes :

 
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 = Image1) or (Source = Image2);
  case State of
    dsDragEnter: lblState.Caption := Format('%s entre sur %s', [(Source as TImage).Name,
      (Sender as TImage).Name]);
    dsDragLeave: lblState.Caption := Format('%s quitte %s', [(Source as TImage).Name,
      (Sender as TImage).Name]);
    dsDragMove: lblState.Caption := Format('%s se déplace sur %s', [(Source as TImage).Name,
      (Sender as TImage).Name]);
  end;
  // AJOUT !!!
  lblOver.Caption := Format('OnDragOver : %d:%d', [X, Y]);
end;

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;
  // AJOUT !!!
  lblDrop.Caption := Format('OnDragDrop : %d:%d', [X, Y]);
end;

end.

Vous n'aurez qu'à formater un court message pour chacun des gestionnaires.

L'exécution pourra donner lieu à des affichages comme le suivant :

Image non disponible

Ce qu'il est important de noter :

  • les coordonnées X et Y de OnDragOver et de OnDragDrop ne sont bien évidemment récupérables que lors de l'activation des gestionnaires, c'est-à-dire lorsqu'ils sont appelés ;
  • les coordonnées X et Y sont fournies en fonction de la zone client du contrôle survolé et non en fonction de l'écran ou de la fenêtre activée ;
  • OnDragOver est appelé très souvent alors que OnDragDrop n'est appelé qu'à l'issue d'un dépôt.

III. Conclusion

Avec ce tutoriel, vous aurez appris à personnaliser le glisser-déposer standard tel qu'il avait été présenté dans la première partie.

Désormais, vous savez :

  • utiliser les propriétés centralisées d'une application ;
  • personnaliser le bouton actif de la souris ;
  • prévoir un seuil avant le déclenchement du mécanisme de glisser-déposer ;
  • savoir si un glisser-déposer est en cours ;
  • vérifier finement le déplacement de la souris au-dessus d'un contrôle.

Vous êtes prêt pour approfondir ces connaissances et vous lancer dans des défis plus importants, ce que proposera le dernier volet de cette série de tutoriels sur le glisser-déposer avec Lazarus.

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.