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

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

Maîtrise du dessin et des événements

Après avoir étudié les techniques de base à mettre en œuvre pour le glisser-déposer avec Free Pascal et Lazarus, puis des techniques particulières de personnalisation, il s'agit à présent de pousser plus loin la maîtrise des images et des événements liés à cette technique qui devrait alors ne plus présenter de secrets pour vous.

1 commentaire 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.

L'exposé qui suit vous aidera à personnaliser davantage vos applications qui utiliseront le glisser-déposer, en particulier au niveau des images fournies à l'utilisateur lorsque ce mécanisme est en œuvre.

Allant aussi plus loin dans la compréhension des différents événements qui interviennent tout au long du processus du glisser-déposer, vous serez alors en mesure de comprendre une application assez sophistiquée fondée sur le principe d'un puzzle à reconstituer.

II. Le contrôle des images

Parmi les améliorations attendues au système standard de glisser-déposer, il en est une qui est le plus souvent plébiscitée : chacun espère que les icônes en forme de rectangle et d'interdiction qui sont censés indiquer le statut du mécanisme à un instant donné ne sont pas les seules autorisées. Heureusement, il n'en est rien, même s'il ne faut pas chercher à innover à tout prix. L'utilisateur vous saura souvent gré de le rassurer tant la force de l'habitude garantit un moindre effort pour s'approprier un nouveau logiciel. Cependant, il existe des circonstances où les changements s'imposent et vous restez seul maître des décisions prises !

II-A. Changer d'icônes lors du glissement

Les icônes indiquant qu'un contrôle est en cours de glisser-déposer sont par défaut les curseurs crDrag et crNoDrop. Seul le premier est accessible facilement puisque présent en tant que propriété publiée (DragCursor). Le second nécessite de modifier l'objet de type TDragObect de support, ce qui complique singulièrement la tâche.

II-A-1. Utiliser les curseurs prédéfinis

Le plus simple consiste à adapter la propriété DragCursor du contrôle d'où partira le glisser-déposer. Par défaut, cette propriété vaut crDrag, mais vous constaterez qu'elle peut prendre autant de valeurs que sa consœur plus utilisée Cursor :

Image non disponible

Si le choix de certains de ces curseurs potentiels est loin d'être judicieux, vous adopterez par exemple crUpArrow pour une image placée au-dessous d'une autre : quoi de plus pertinent qu'une flèche pointant vers le haut pour indiquer le sens du déplacement ?

II-A-2. Utiliser ses propres curseurs

Si vous remontez dans le code source jusqu'à leur déclaration (unité Controls), vous constaterez que les constantes associées aux différents curseurs sont des valeurs entières négatives. Les valeurs positives sont en effet destinées à identifier vos propres curseurs. Il est ainsi possible d'associer des ressources propres à vos curseurs.

Il existe plusieurs techniques pour parvenir à vos fins, mais la plus moderne et la plus efficace consiste à inclure dans votre code source un fichier de ressources à l'extension .res et de faire appel à la classe TCursorImage pour la gestion de l'image à utiliser.

L'équipe de Lazarus a décidé d'abandonner progressivement son format particulier .lrs pour adopter celui de Windows en .res. Il est vivement conseillé de suivre cette recommandation de format sous peine d'être un jour contraint de convertir tous les fichiers de ressources produits jusqu'alors.

La procédure complète comprend trois étapes :

  • vous créez un fichier de ressources contenant les images des curseurs voulus ;
  • vous définissez vos propres constantes pour identifier les curseurs en vous servant de leur identifiant de ressource ;
  • vous chargez les nouveaux curseurs dans la propriété tableau Cursors de l'objet Screen.

Généralement, la première étape, à savoir la création d'un fichier de ressources, s'effectue à l'aide d'un logiciel dédié. Le propos ici n'est pas de détailler un mode d'emploi quelconque, mais de rappeler qu'il suffit d’ajouter les fichiers binaires à un fichier de ressources et que chaque ressource sera identifiée par un identifiant entier unique.

Pour ma part, j'utilise volontiers ResourceHacker sous Windows, un logiciel gratuit, sans publicité et très performant. Vous pouvez aussi utiliser windres fourni dans le répertoire bin de Free Pascal : il est alors possible de travailler avec Linux.

[Exemple DragAndDrop 19]

Pour illustrer cela, vous allez reprendre l'application d'échange des deux images, mais en modifiant l'apparence de son interface utilisateur :

Image non disponible

Pour cet exemple, un fichier de ressources baptisé cursors.res comprend trois curseurs personnalisés identifiés par les nombres entiers de 1 à 3.

Comme annoncé, vous indiquerez la valeur crUpArrow pour la propriété DragCursor d'Image2. Par ailleurs, les deux images doivent, comme bien souvent, avoir leur propriété DragMode à dmAutomatic.

Dans le code source de l'unité vont figurer quelques ajouts : les constantes identifiant les nouveaux curseurs, l'inclusion du fichier de ressources nommé cursors.res et le chargement de ces curseurs dans le gestionnaire OnCreate de la fiche principale :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

const
  crDragHand = 1; // les constantes relatives aux nouveaux curseurs
  crDragFolder = 2;
  crDragFile = 3;

type

  { TMainForm }

  TMainForm = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(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}
{$R cursors.res} // le nouveau fichier de ressources avec les curseurs

{ 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.FormCreate(Sender: TObject);
// *** création d'un curseur personnalisé ***
var
  LCur: TCursorImage;
begin
  LCur := TCursorImage.Create;
  try
    LCur.LoadFromResourceId(HInstance, crDragHand);
    Screen.Cursors[crDragHand] := LCur.ReleaseHandle;
  finally
    LCur.Free;
  end;
  Image1.DragCursor := crDragHand;
end;

end.

Dans l'exemple en cours, afin d'en simplifier sa compréhension, un seul curseur est enregistré et utilisé. Vous pourriez bien entendu tous les enregistrer dans une boucle et les exploiter selon vos besoins, les seules exigences étant que ces ressources existent et que le fichier de ressources soit accessible à la compilation.

À l'exécution, le programme est autonome et fournira ce genre d'affichage :

Image non disponible

Comme prévu, avec la seconde image comme point de départ, c'est une flèche tournée vers le haut de l'écran qui sera affichée :

Image non disponible

Sous Linux, certains curseurs n'existent pas. C'est justement le cas de la flèche tournée vers le haut qui sera tout simplement ignorée. Il faut par conséquent vérifier la validité d'un curseur avant de livrer l'application !

II-A-3. Modifier le curseur de refus de dépôt

Changer le curseur de refus de dépôt est un peu plus difficile, car il est toujours codé en dur. Il va falloir par conséquent créer un descendant de la classe TDragObject et surcharger la méthode en charge des curseurs, à savoir GetDragCursor.

[Exemple DragAndDrop 20]

Parmi les descendants de TDragObject, une classe paraît tout à fait pertinente pour la dérivation souhaitée : non seulement TDragControlObjectEx est directement adaptée à la prise en charge d'un contrôle, mais elle a la capacité à se libérer seule après emploi, ce qui évitera le problème du nettoyage des ressources allouées.

Voici la classe nécessaire à l'exemple proposé :

 
Sélectionnez
{ TImgDragObject }

  TImgDragObject = class(TDragControlObjectEx)
  protected
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
  end;

La méthode surchargée est très simple à implémenter :

 
Sélectionnez
function TImgDragObject.GetDragCursor(Accepted: Boolean; X, Y: Integer
  ): TCursor;
// *** curseur personnalisé si le dépôt n'est pas accepté ***
begin
  Result := inherited;
  if not Accepted then
    Result := crCustomNoDrag;
end;

Elle ne fait que récupérer le curseur défini précédemment (donc y compris sa personnalisation par le contrôle) pour le modifier dans le seul cas où le dépôt ne serait pas accepté, ce qui est indiqué par le paramètre Accepted.

Une manœuvre reste à opérer : il faut indiquer à l'application qu'elle doit utiliser cette classe personnalisée au lieu de la classe standard dont elle génère automatiquement un objet autogéré. Pour cela, vous utiliserez le gestionnaire OnStartDrag qui comprend un objet de type TDragObject dans son en-tête :

 
Sélectionnez
procedure TMainForm.Image1StartDrag(Sender: TObject; var DragObject: TDragObject
  );
// *** création de l'objet glisser-déposer lors du démarrage du glisser ***
begin
  DragObject := TImgDragObject.Create(Sender as TControl);
end;

À présent, tout est presque prêt pour l'utilisation d'un curseur nommé crCustomNoDrag. Il ne reste qu'à définir cette constante et de lui faire correspondre une image du fichier de ressources enrichi d'une image.

Le listing du code source final de la fiche sera le suivant :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

const
  crDragHand = 1;
  crDragFolder = 2;
  crDragFile = 3;
  crCustomNoDrag = 4; // nouvelle icône

type

  { TMainForm }

  TMainForm = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
    procedure Image1StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
      {%H-}State: TDragState; var Accept: Boolean);
  private
    { private declarations }
  public
    { public declarations }
  end;

  { TImgDragObject }

  TImgDragObject = class(TDragControlObjectEx)
  protected
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TImgDragObjectEx }

function TImgDragObject.GetDragCursor(Accepted: Boolean; X, Y: Integer
  ): TCursor;
// *** curseur personnalisé si le dépôt n'est pas accepté ***
begin
  Result := inherited;
  if not Accepted then
    Result := crCustomNoDrag;
end;

{$R cursors.res}

{ TMainForm }

procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
var
  LControl: TControl;
begin
  LControl := nil;
  if Source is TControl then
    LControl := (Source as TControl)
  else
  if Source is TDragControlObject then
    LControl := (Source as TDragControlObject).Control;
  Accept := (LControl is TImage);
end;

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

procedure TMainForm.Image1StartDrag(Sender: TObject; var DragObject: TDragObject
  );
// *** création de l'objet glisser-déposer lors du démarrage du glisser ***
begin
  DragObject := TImgDragObject.Create(Sender as TControl);
end;

procedure TMainForm.FormCreate(Sender: TObject);
// *** curseur personnalisé ***
var
  LCur: TCursorImage;
begin
  LCur := TCursorImage.Create;
  try
    LCur.LoadFromResourceId(HInstance, crDragHand);
    Screen.Cursors[crDragHand] := LCur.ReleaseHandle;
    LCur.LoadFromResourceId(HInstance, crCustomNoDrag);
    Screen.Cursors[crCustomNoDrag] := LCur.ReleaseHandle;
  finally
    LCur.Free;
  end;
  Image1.DragCursor := crDragHand;
end;

end.

Lors d'un refus de dépôt, l'exécution donnera lieu à des écrans comme celui-ci :

Image non disponible

Vous noterez que le premier curseur personnalisé est toujours actif : c'est l'intérêt de s'appuyer sur la classe TDragControlObjectEx pour surcharger la méthode GetDragCursor. Notez aussi que vous auriez très bien pu, dans cette même méthode, vous servir d'un curseur prédéfini : par exemple, crNo.

II-B. Choisir une image entièrement personnalisée

Du point de vue des images associées au glisser-déposer, il reste un ultime pas à franchir en prenant en charge un dessin entièrement personnalisé. Finalement, vous allez voir que redessiner toute l'image associée à un glisser-déposer ne diffère pas beaucoup de ce que vous venez de réaliser. Le mécanisme est similaire si ce n'est qu'il faut préciser le dessin exact tel qu'il est souhaité.

[Exemple DragAndDrop 21]

L'exemple de base restant le même, il faut de nouveau modifier l'objet chargé du glisser-déposer en arrière-plan, à travers une adaptation de sa classe au problème posé :

 
Sélectionnez
 TImgDragObject = class(TDragControlObjectEx)
  private
    fDragImages: TDragImageList;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create(AControl: TControl); override;
  end;

C'est la liste d'images associée à l'objet qui va mériter toute votre attention, quand bien même cette liste sera réduite à l'unique image correspondant à celle déplacée.

L'implémentation de la méthode est évidente :

 
Sélectionnez
function TImgDragObject.GetDragImages: TDragImageList;
// *** images à déplacer ***
begin
  Result := fDragImages;
end;

Au lieu de nil affecté par défaut à la liste, vous utilisez votre propre objet de type TDragImageList.

Quant au constructeur, il fournit toutes les informations nécessaires au dessin lui-même :

 
Sélectionnez
constructor TImgDragObject.Create(AControl: TControl);
// *** création de l'objet glisser-déposer ***
begin
  inherited Create(AControl);
  fDragImages := TDragImageList.Create(AControl);
  AlwaysShowDragImages := True;
  fDragImages.Width := (AControl as TImage).Width;
  fDragImages.Height := (AControl as TImage).Height;
  fDragImages.Add((AControl as TImage).Picture.Bitmap, nil);
  // pour Linux : fDragImages.DragHotspot := Point(-10, -10);
  fDragImages.DragHotspot := Point(fDragImages.Width div 2, fDragImages.Height div 2);
end;

En dehors du dimensionnement de l'image à afficher qui doit avoir ici la même taille que celles à échanger, vous remarquerez l'emploi de AlwaysShowDragImages pour forcer son affichage et de DragHotSpot pour en définir le point qui sera celui de saisie.

Sous Linux, DragHotSpot doit posséder des paramètres tels que le point de contrôle se situe en dehors du dessin déplacé, sinon le dépôt est rendu impossible !

L'exécution de cette application donnera lieu à des instantanés comme le suivant :

Image non disponible

Voilà qui commence à prendre bonne tournure, non ?

Le reste du code n'est en rien modifié par rapport à l'exemple précédent et vous devriez en comprendre le fonctionnement d'ensemble sans trop de difficultés :

 
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;
    procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
    procedure Image1StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
      {%H-}State: TDragState; var Accept: Boolean);
  private
    { private declarations }
  public
    { public declarations }
  end;

  { TImgDragObject }

  TImgDragObject = class(TDragControlObjectEx)
  private
    fDragImages: TDragImageList;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create(AControl: TControl); override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TImgDragObject }

function TImgDragObject.GetDragImages: TDragImageList;
// *** images à déplacer ***
begin
  Result := fDragImages;
end;

constructor TImgDragObject.Create(AControl: TControl);
// *** création de l'objet glisser-déposer ***
begin
  inherited Create(AControl);
  fDragImages := TDragImageList.Create(AControl);
  AlwaysShowDragImages := True;
  fDragImages.Width := (AControl as TImage).Width;
  fDragImages.Height := (AControl as TImage).Height;
  fDragImages.Add((AControl as TImage).Picture.Bitmap, nil);
  fDragImages.DragHotspot := Point(fDragImages.Width div 2, fDragImages.Height div 2);
end;

{ TMainForm }

procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
var
  LControl: TControl;
begin
  LControl := nil;
  if Source is TControl then
    LControl := (Source as TControl)
  else
  if Source is TDragControlObject then
    LControl := (Source as TDragControlObject).Control;
  Accept := (LControl is TImage);
end;

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

procedure TMainForm.Image1StartDrag(Sender: TObject; var DragObject: TDragObject
  );
// *** création de l'objet glisser-déposer lors du démarrage du glisser ***
begin
  DragObject := TImgDragObject.Create(Sender as TControl);
end;

end.

III. Les événements lors d'un glisser-déposer

L'objectif de cette partie est de mieux comprendre le fonctionnement d'un glisser-déposer, essentiellement à travers les différents événements déclenchés : après avoir exploré des situations plutôt complexes, il s'agit par conséquent d'une forme de retour en arrière approfondi.

Cette compréhension plus intime du mécanisme mis en œuvre avec le glisser-déposer devrait vous permettre de l'adapter à vos besoins en suivant un ordre de difficulté croissante :

  • en modifiant des propriétés des contrôles ;
  • en exploitant les données accessibles depuis un gestionnaire d'événements et en faisant appel à quelques routines utiles ;
  • en dérivant une classe de l'ancêtre essentiel TDragObject.

Vous aurez compris que cet ordre est aussi celui que devrait suivre votre réflexion : pourquoi vouloir faire compliqué si une solution simple se présente à vous ? Mais pour cela, vous avez besoin de bien connaître la chronologie des événements depuis le moment où l'utilisateur enclenche le glissement sur un contrôle jusqu'à celui où il dépose son fardeau.

III-A. Une valse à quatre temps

En premier lieu, le schéma type du glisser-déposer comprend quatre étapes dont les deux centraux sont optionnels : OnStartDrag, OnDragOver, OnDragDrop et OnEndDrag.

OnStartDrag marque le début du processus. Sa forme est définie ainsi :

 
Sélectionnez
TStartDragEvent = procedure(Sender: TObject; var DragObject: TDragObject) of object;

Sender correspond au contrôle d'où est initié le glisser-déposer. Le paramètre variable DragObject permet de définir un objet de type TDragObject personnalisé ; en son absence, c'est un objet caché de type TDragObjectEx qui est automatiquement créé et détruit quand nécessaire.

OnDragOver indique le survol d'un contrôle par un objet en glissement. Sa forme est la suivante :

 
Sélectionnez
TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
TDragOverEvent = procedure(Sender, Source: TObject;
               X,Y: Integer; State: TDragState; var Accept: Boolean) of object;

Sender est le contrôle survolé et Source celui d'origine. La position du curseur de la souris est fournie par les paramètres X et Y tandis que State indique l'état de la souris parmi les trois possibles de l'énumération TDragState. Le paramètre variable Accept est le plus important : si le gestionnaire est renseigné, Accept peut être contrôlé, sachant qu'il vaut True par défaut ; si le gestionnaire est absent, Accept est automatiquement mis à False.

OnDragOver n'est pas appelé si la souris est immobile. Le gestionnaire peut par conséquent ne jamais être appelé si le glisser-déposer est interrompu avant tout mouvement de la souris.

Comme l'appel à OnDragOver est susceptible d'être répété un nombre considérable de fois tant que la souris se déplace au-dessus du contrôle prêt à l'accepter ou à le refuser, il faut prendre garde de ne pas trop alourdir les calculs en son sein, car les performances de l'application pourraient s'en ressentir.

OnDragDrop intervient si le dépôt a lieu sur un contrôle qui accepte la source. Le gestionnaire prend la forme ci-après :

 
Sélectionnez
TDragDropEvent = procedure(Sender, Source: TObject; X,Y: Integer) of object;

Sender est encore le contrôle ayant envoyé le message et Source celui dont provenait le glisser-déposer. Les coordonnées X et Y permettent de savoir précisément où a eu lieu le dépôt dans un repère lié à Sender.

L'appel à OnDragDrop est subordonné à la réussite du processus : en cas d'échec, il est donc ignoré.

OnEndDrag marque la fin du mécanisme de glisser-déposer. La forme du gestionnaire est la suivante :

 
Sélectionnez
TEndDragEvent = procedure(Sender, Target: TObject; X,Y: Integer) of object;

Sender est le contrôle qui avait pris en charge le glisser-déposer et Target représente la cible visée. Une fois encore, les coordonnées X et Y permettent de préciser l'emplacement du curseur de la souris par rapport à Target. Si la cible est erronée (en cas d'abandon ou de mauvaise destination), Target vaut nil et les coordonnées X et Y valent toutes les deux 0.

Il est important de noter que l'objet de type TDragObject est créé avec ou après le gestionnaire OnStartDrag et qu'il doit être détruit avec OnEndDrag (destruction automatique seulement avec TDragObjectEx ou ses descendants). Avant OnStartDrag, il est fait appel à la méthode BeginDrag qui peut elle-même différer de Threhold le glisser-déposer au cas où son premier paramètre est à False.

III-B. L'intrication avec les événements liés à la souris

Les difficultés réelles commencent lorsque les événements liés à la souris doivent être pris en compte. En effet, l'ordre de déclenchement des événements peut être crucial pour votre application en la perturbant si vous n'y prenez pas garde.

Par exemple, imaginez que vous vous déplaciez jusqu'à une image avant de cliquer sur elle pour enclencher un glisser-déposer et que vous la déposiez sur un contrôle l'acceptant. Les premiers événements seront ceux-ci :

OnMouseMove (x fois) / OnStartDrag / OnDragOver / OnMouseDown

Il est plutôt déroutant de constater que le clic sur la souris est pris en compte après les événements relatifs au glisser-déposer alors qu'il intervient chronologiquement avant.

Suit alors une séquence répétitive tant que le contenu du contrôle n'est pas lâché sur celui visé :

séquence OnDragOver / OnMouseMove (x fois avec fin sur OnDragOver)

Enfin, la séquence finale correspondant au dépôt prend la forme suivante :

OnDragDrop / OnEndDrag / OnMouseUp

Là encore, l'événement correspondant au bouton de la souris relâchée est déclenché après la fin du dépôt.

Les événements qui suivent directement le glisser-déposer sont encore plus étonnants :

OnMouseEnter / OnMouseMove / OnMouseLeave

Ils indiquent clairement que la prise en compte de l’entrée de la souris dans le contrôle cible, son survol et son abandon interviennent encore une fois après le glisser-déposer.

Par conséquent, il faut vous montrer très prudent lors de l'utilisation des événements liés à la souris alors qu'un glisser-déposer est en cours : ils sont pris en compte après ces derniers.

Accessoirement, afin d'avoir une vue d'ensemble du mécanisme, notez que la méthode BeginDrag intervient juste avant OnStartDrag, que la création de l'objet de type TDragObject se situe juste après le même gestionnaire OnStartDrag (ce qui permet d'ailleurs de préciser la classe réelle à créer) et que sa destruction suit l'appel au gestionnaire OnEndDrag.

Vous avez à présent tous les points d’entrée de vos interventions : les outils étudiés précédemment viendront s'y loger selon vos besoins et fonctionneront si vous tenez compte des particularités évoquées.

[Exemple DragAndDrop 22]

Rien ne vaut la réalisation d'une application en action pour vérifier ce qui vient d'être avancé et c'est ce à quoi vous allez vous atteler.

Tout d'abord, voici l’interface utilisateur suggérée :

Image non disponible

Comme vous pouvez le voir, trois contrôles sont proposés pour le glisser-déposer : un TLabel et un TEdit activés, ainsi qu'une TComboBox désactivée. De plus, deux TMemo sont disponibles : le premier recevra les éléments déplacés tandis que le second affichera les messages envoyés par les gestionnaires. Enfin, deux TCheckBox serviront de filtres aux messages traités.

L'unité principale sera alors celle-ci :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

type
  TCustomMessages = (cmessNone, cmessDragDrop, cmessDragOver, cmessEndDrag,
    cmessStartDrag, cmessMouseDown,
    cmessMouseUp, cmessMouseMove, cmessMouseEnter, cmessMouseLeave);

  { TMainForm }

  TMainForm = class(TForm)
    btnClear: TButton;
    cbxDummy: TComboBox;
    cbDetails: TCheckBox;
    cbMouse: TCheckBox;
    edtText: TEdit;
    LblOver: TLabel;
    lblText: TLabel;
    mmoActions: TMemo;
    mmoMain: TMemo;
    procedure btnClearClick(Sender: TObject);
    procedure edtTextMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure lblTextDragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
    procedure lblTextDragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
      {%H-}State: TDragState; var Accept: Boolean);
    procedure lblTextEndDrag(Sender, Target: TObject; {%H-}X, {%H-}Y: Integer);
    procedure lblTextMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
      {%H-}Shift: TShiftState; X, Y: Integer);
    procedure lblTextMouseUp(Sender: TObject; {%H-}Button: TMouseButton;
      {%H-}Shift: TShiftState; X, Y: Integer);
    procedure lblTextStartDrag(Sender: TObject; var {%H-}DragObject: TDragObject);
    procedure mmoMainEndDrag(Sender, {%H-}Target: TObject; {%H-}X, {%H-}Y: Integer);
    procedure mmoMainMouseEnter(Sender: TObject);
    procedure mmoMainMouseLeave(Sender: TObject);
    procedure mmoMainStartDrag(Sender: TObject; var {%H-}DragObject: TDragObject);
  private
    { private declarations }
    MainState: TCustomMessages;
    function SameState(AState: TCustomMessages): Boolean;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.lblTextDragDrop(Sender, Source: TObject; X, Y: Integer);
// *** lâcher sur les contrôles ***
begin
  if SameState(cmessDragDrop) then
    exit;
  if (Source <> nil) then
    mmoActions.Lines.Add(Format('[ONDRAGDROP de %s %s] Lâcher depuis %s %s ',
      [(Sender as TObject).ClassName, (Sender as TComponent).Name,
      (Source as TObject).ClassName, (Source as TComponent).Name]))
  else
    mmoActions.Lines.Add(Format('[ONDRAGDROP de %s %s] Lâcher depuis nil ',
      [(Sender as TObject).ClassName, (Sender as TComponent).Name]));
  if (Sender is TMemo) then
    mmoMain.Lines.Add((Source as TControl).Caption + ' ');
end;

procedure TMainForm.btnClearClick(Sender: TObject);
// *** nettoyage des affichages ***
begin
  mmoMain.Lines.Clear;
  mmoActions.Lines.Clear;
  MainState := cmessNone;
end;

procedure TMainForm.edtTextMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
// *** déplacement de la souris ***
begin
  if cbMouse.Checked then
  begin
    if SameState(cmessMouseMove) then
      exit;
    mmoActions.Lines.Add(Format('[ONMOUSEMOVE de %s %s] Déplacement de la souris en %d, %d. ',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name, X, Y]));
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche ***
begin
  MainState := cmessNone;
end;

procedure TMainForm.lblTextDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
// *** survol des contrôles ***
begin
  if SameState(cmessDragOver) then
    exit;
  Accept := (Sender is TMemo) and ((Source is TLabel) or (Source is TEdit));
  if Accept then
    mmoActions.Lines.Add(Format('[ONDRAGOVER de %s %s] En survol, %s %s est accepté.',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name,
    (Source as TObject).ClassName, (Source as TComponent).Name]))
  else
    mmoActions.Lines.Add(Format('[ONDRAGOVER de %s %s] En survol, %s %s est refusé.',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name,
    (Source as TObject).ClassName, (Source as TComponent).Name]));
  if cbDetails.Checked then
  begin
    case State of
      dsDragEnter: mmoActions.Lines.Add(Format('La souris entre en %d, %d.', [X, Y]));
      dsDragLeave: mmoActions.Lines.Add(Format('La souris sort en %d, %d.', [X, Y]));
      dsDragMove: mmoActions.Lines.Add(Format('La souris survole le point %d, %d.', [X, Y]));
    end;
  end;
end;

procedure TMainForm.lblTextEndDrag(Sender, Target: TObject; X, Y: Integer);
// *** fin de glisser pour les contrôles actifs ***
begin
  if SameState(cmessEndDrag) then
    exit;
  if (Target <> nil) then
    mmoActions.Lines.Add(Format('[ONENDDRAG de %s %s] Fin du glisser vers %s %s - Position : %d,%d. ',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name,
    (Target as TObject).ClassName, (Target as TComponent).Name, X, Y]))
  else
    mmoActions.Lines.Add(Format('[ONENDDRAG de %s %s] Fin du glisser vers %s - Position : %d,%d. ',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name, 'nil', X, Y]));
end;

procedure TMainForm.lblTextMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
// *** bouton de la souris cliqué ***
begin
  if (Sender is TLabel) and (Button = mbRight) then
    (Sender as TLabel).BeginDrag(False);
  if cbMouse.Checked then
  begin
    if SameState(cmessMouseDown) then
      exit;
    mmoActions.Lines.Add(Format('[ONMOUSEDOWN de %s %s] Clic de la souris en %d, %d. ',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name, X, Y]));
  end;
end;

procedure TMainForm.lblTextMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
// *** bouton de la souris relevé ***
begin
  if cbMouse.Checked then
  begin
    if SameState(cmessMouseUp) then
      exit;
    mmoActions.Lines.Add(Format('[ONMOUSEUP de %s %s] Fin de clic de la souris en %d, %d. ',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name, X, Y]));
  end;
end;

procedure TMainForm.lblTextStartDrag(Sender: TObject;
var DragObject: TDragObject);
// *** début de glisser pour les contrôles actifs ***
begin
  if SameState(cmessStartDrag) then
    exit;
  mmoActions.Lines.Add(Format('[ONSTARTDRAG de %s %s] Début du glisser. ',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name]));
end;

procedure TMainForm.mmoMainEndDrag(Sender, Target: TObject; X, Y: Integer);
// *** fin de glisser pour le MEMO de réception => jamais appelé ! ***
begin
  mmoActions.Lines.Add('[ONENDDRAG de MEMO');
end;

procedure TMainForm.mmoMainMouseEnter(Sender: TObject);
// *** la souris entre dans le contrôle ***
begin
  if cbMouse.Checked then
  begin
    if SameState(cmessMouseEnter) then
    exit;
    mmoActions.Lines.Add(Format('[ONMOUSEENTER de %s %s] La souris entre. ',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name]));
  end;
end;

procedure TMainForm.mmoMainMouseLeave(Sender: TObject);
// *** la souris sort du contrôle ***
begin
  if cbMouse.Checked then
  begin
    if SameState(cmessMouseLeave) then
    exit;
    mmoActions.Lines.Add(Format('[ONMOUSELEAVE de %s %s] La souris sort. ',
    [(Sender as TObject).ClassName, (Sender as TComponent).Name]));
  end;
end;

procedure TMainForm.mmoMainStartDrag(Sender: TObject;
  var DragObject: TDragObject);
// *** début de glisser pour le MEMO de réception => jamais appelé ! ***
begin
   mmoActions.Lines.Add('ONSTARTDRAG de MEMO');
end;

function TMainForm.SameState(AState: TCustomMessages): Boolean;
// *** changement d'état ***
begin
  Result := (MainState = AState);
  if Result then
  begin
    mmoActions.Lines[mmoActions.Lines.Count-1] :=
      mmoActions.Lines[mmoActions.Lines.Count-1] + '*';
  end
  else
    MainState := AState
end;


end.

Bien que copieux, le contenu de cette unité n'est pas compliqué à comprendre : chaque gestionnaire scruté indique qu'il a été appelé en complétant un TMemo baptisé mmoActions. Un drapeau est fourni par une TCheckBox (cbMouse) dont la fonction est d'inclure ou non les événements liés à la souris. De la même façon, un autre drapeau provient d'une seconde TCheckBox (cbDetails) qui procure ou non certains détails comme la position de la souris. Une méthode baptisée SameState permet d'éviter une accumulation d'événements identiques qui seront avantageusement remplacés par des séries d'astérisques. Enfin, nombre de méthodes procèdent par transtypage afin de rendre compte des objets manipulés.

Certains gestionnaires ont été renseignés alors qu'ils ne seront jamais appelés : il ne s'agit pas d'une erreur, mais bien de la volonté d'illustrer au mieux les appels réels, ceux espérés et ceux qui n'auront jamais lieu !

L'essentiel pour vous est bien évidemment de vérifier les indications données ci-avant sur l'ordre d'appel des gestionnaires d'événements et d'essayer différentes configurations. Vous serez alors en mesure d'enrichir vos applications par une maîtrise très fine des événements qu'elle générera.

IV. Une application de dessin complète

Pour clore ce tour d'horizon des techniques liées au glisser-déposer, vous allez réaliser une application complète dont le thème est le puzzle. Une image au choix est découpée en douze carrés qui sont mélangés à l'écran et qu'il faudra remettre dans leur ordre d'origine.

[Exemple DragAndDrop 23]

Voici une copie de l'application en cours d'exécution :

Image non disponible

Le glisser-déposer interviendra doublement : d'une part, il sera possible de choisir une autre image que celle proposée par défaut en la déposant grâce au gestionnaire de fichiers ; d'autre part, les portions sous forme de carrés pourront être interverties jusqu'à l'obtention de l'image originelle.

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

Image non disponible

Vous y apercevez un composant TImage de grande taille et douze autres dont la propriété DragMode est fixée à dmAutomatic tandis que leurs gestionnaires en lien avec le glisser-déposer sont renseignés comme indiqué plus loin. La fiche elle-même voit sa propriété AllowDropFiles fixée à True. Tout est par conséquent en place pour le glisser-déposer.

Par ailleurs, quelques composants viennent compléter l'ensemble : un composant non visuel TOpenPictureDialog pour le chargement d'une nouvelle image, trois TButton correspondant à trois actions (nouveau puzzle, solution et mélange des portions d'image), un TLabel pour l'affichage du score, ainsi qu'une TCheckBox pour cacher ou montrer le modèle de départ.

IV-A. Le traitement des images

En premier lieu, il faut que vous fournissiez une procédure capable de découper les images. Vous pourrez par exemple vous inspirer de celle-ci :

 
Sélectionnez
procedure TMainForm.SplitBitmap(ABitmapSrc, ABitmapDest: TBitmap;
  NumberOfPartsX, NumberOfPartsY, APartX, APartY: Integer);
// *** découpage d'une image en portions ***
var
  LBtp: TBitmap;
begin
  LBtp := TBitmap.Create;
  try
    LBtp.Width := ABitmapSrc.Width div NumberOfPartsX;
    LBtp.Height := ABitmapSrc.Height div NumberOfPartsY;
    LBtp.Canvas.CopyRect(Rect(0, 0, LBtp.Width, LBtp.Height),
      ABitmapSrc.Canvas,
      Rect(APartX * LBtp.Width, APartY * LBtp.Height, (APartX + 1) * LBtp.Width,
      (APartY + 1) * LBtp.Height));
    ABitmapDest.SetSize(LBtp.Width, LBtp.Height);
    ABitmapDest.Canvas.Draw(0, 0, LBtp);
  finally
    LBtp.Free;
  end;
end;

Cette méthode prend en paramètres les bitmaps source et destination, le nombre de colonnes et de lignes, ainsi que les coordonnées de la portion désirée. Quand bien même l'application d'exemple comporte un nombre figé de portions, la méthode pourra ainsi s'adapter avec souplesse à d'autres situations.

La préparation des portions d'image pourra alors prendre cette forme :

 
Sélectionnez
const
  C_Cols = 4;
  C_Rows = 3;

type
  TArrayOfBitmaps = array[0..C_Cols * C_Rows - 1] of TBitmap;
  TArrayOfIndex = array[0..C_Cols * C_Rows - 1] of Integer;

[…]

TMainForm = class(TForm)
[…]
  
  private
    { private declarations }
    fArrayOfBitmaps: TArrayOfBitmaps;
    fArrayOfIndex: TArrayOfIndex;
[…]

procedure TMainForm.PrepareImages;
// *** préparation des images ***
var
  Li: Integer;
begin
  for Li := Low(fArrayOfBitmaps) to High(fArrayOfBitmaps) do
  begin
    fArrayOfBitmaps[Li] := TBitmap.Create;
    fArrayOfBitmaps[Li].SetSize(Img01.Width, Img01.Height);
    SplitBitmap(ImageMain.Picture.Bitmap, fArrayOfBitmaps[Li], C_Cols, C_Rows,
      Li mod C_Cols, Li div C_Cols);
  end;
end;

Le tableau des portions d'image est rempli en créant les bitmaps dans une boucle et en leur affectant la portion désirée depuis la méthode précédemment définie. Bien entendu, il faudra penser à libérer ces bitmaps quand ils seront devenus inutiles :

 
Sélectionnez
procedure TMainForm.FreeImages;
// *** destruction des portions de l'image principale ***
var
  Li: Integer;
begin
  for Li := Low(fArrayOfBitmaps) to High(fArrayOfBitmaps) do
    FreeAndNil(fArrayOfBitmaps[Li]);
end;

Comme il faut se souvenir de leur emplacement d'origine, la solution adoptée est de construire un tableau parallèle des index des portions :

 
Sélectionnez
procedure TMainForm.ShuffleImages;
// *** mélange des images ***
var
  L1, L2, LT, Li: Integer;
begin
  // tableau des index ordonnés à jour
  for Li := Low(fArrayOfIndex) to High(fArrayOfIndex) do
    fArrayOfIndex[Li] := Li;
  // mélange des index
  for Li := 1 to 100 do
  begin
    L1 := random(C_Rows * C_Cols);
    L2 := random(C_Rows * C_Cols);
    LT := fArrayOfIndex[L1];
    fArrayOfIndex[L1] := fArrayOfIndex[L2];
    fArrayOfIndex[L2] := LT;
  end;
end;

L'identification des composants TImage chargés d'abriter les portions d'image se fait grâce à leur nom dont les trois premières lettres seront « Img » et les deux derniers caractères des chiffres. En mélangeant le tableau d'index, très simple à manipuler puisqu'il est composé d'entiers, vous obtiendrez la séquence des portions d'image à afficher :

 
Sélectionnez
procedure TMainForm.DisplayImages;
// *** affichage des portions de l'image principale ***
var
  Li, LIndex: Integer;
begin
  for Li := 0 to ComponentCount - 1 do
    if (Components[Li] is TImage) and
      (LeftStr(Components[Li].Name, 3) = 'Img')
    then
    begin
      LIndex := fArrayOfIndex[StrToInt(RightStr(Components[Li].Name, 2)) - 1];
      (Components[Li] as TImage).Picture.Bitmap := fArrayOfBitmaps[LIndex];
    end;
end;

La vérification de l'ordre des portions d'images en est grandement facilitée et tient en une méthode qui balaye le tableau d'entiers s'arrête en renvoyant la valeur booléenne False dès qu'un des entiers est mal ordonné :

 
Sélectionnez
function TMainForm.IsOk: Boolean;
// *** ordre retrouvé ? ***
var
  Li: Integer;
begin
  Result := True;
  for Li := Low(fArrayOfIndex) to High(fArrayOfIndex) do
  begin
    if fArrayOfIndex[Li] <> Li then
    begin
      Result := False;
      Break;
    end;
  end;
end;

Par conséquent, le bouton en charge de fournir la solution en cas d'abandon n'a qu'à rétablir l'ordre des portions d'image avant leur affichage :

 
Sélectionnez
procedure TMainForm.btnSoluceClick(Sender: TObject);
// *** solution du puzzle ***
var
  Li: Integer;
begin
  Counter := 0;
  for Li := Low(fArrayOfIndex) to High(fArrayOfIndex) do
    fArrayOfIndex[Li] := Li;
  DisplayImages;
end;

La création de la fiche principale doit préparer les portions d'image en les mélangeant avant de les afficher. Il se trouve que vous avez à votre disposition toutes les méthodes nécessaires :

 
Sélectionnez
procedure TMainForm.FormCreate(Sender: TObject);
// *** préparation de l'image par défaut ***
begin
  Randomize;
  PrepareImages;
  ShuffleImages;
  DisplayImages;
end;

La destruction de la fiche principale doit bien évidemment libérer les ressources allouées :

 
Sélectionnez
procedure TMainForm.FormDestroy(Sender: TObject);
// *** libération des images ***
begin
  FreeImages;
end;

Quant au bouton chargé de mélanger les portions d'images, il réinitialise le compteur de coups joués et fait appel à deux méthodes précédemment définies, d'abord pour le mélange puis pour l'affichage :

 
Sélectionnez
procedure TMainForm.btnShuffleClick(Sender: TObject);
// *** clic sur mélange ***
begin
  Counter := 0;
  ShuffleImages;
  DisplayImages;
end;

IV-B. Le glisser-déposer d'une image

L'image de travail est modifiable selon plusieurs méthodes : l'utilisateur peut cliquer sur l'image en cours, sur un bouton dédié ou déposer un fichier à l'aide du gestionnaire de fichiers.

Les deux premières procédures font appel à la même méthode :

 
Sélectionnez
procedure TMainForm.ImageMainClick(Sender: TObject);
// *** une nouvelle image est choisie ***
begin
  if OpenPictureDialog.Execute then
  begin
    ImageMain.Picture.LoadFromFile(OpenPictureDialog.FileName);
    FreeImages;
    PrepareImages;
    ShuffleImages;
    DisplayImages;
  end;
end;

En revanche, le glisser-déposer, outre la modification de la propriété AllowDropFiles de la fiche principale, nécessite une méthode particulière :

 
Sélectionnez
procedure TMainForm.FormDropFiles(Sender: TObject;
  const FileNames: array of String);
// *** un fichier est déposé sur la fiche ***
var
  LStrList: TStringList;
  LOK: Boolean;
begin
  LStrList := TStringList.Create;
  try
    LStrList.CommaText := '.png,.xpm,.bmp,.cur,.ico,.icns,.jpeg,.jpg,.jpe,.jfif,' +
     '.tif,.tiff,.gif,.pbm,.pgm,.ppm,.dds,.hdr,.o3tc,.tga';
    LOK := LStrList.IndexOf(LowerCase(ExtractFileExt(FileNames[0]))) <> - 1;
  finally
    LStrList.Free;
  end;
  if LOK then
  begin
    if Length(FileNames) > 1 then
      MessageDlg('Fichier à charger', 'Seul le premier fichier sera chargé !', mtWarning,
        [mbOk], 0);
    ImageMain.Picture.LoadFromFile(FileNames[0]);
    FreeImages;
    PrepareImages;
    ShuffleImages;
    DisplayImages;
  end
  else
    MessageDlg('Fichier à charger', 'Le format de ce fichier est inconnu !', mtError,
      [mbOk], 0);
end;

Ce qui alourdit quelque peu l'ensemble tient à la vérification de la nature du fichier choisi : vous ne pouvez accepter qu'un seul fichier de type image.

IV-C. L'échange des portions d'image par glisser-déposer

L'échange des portions d'image est une tâche que vous avez déjà rencontrée et qui nécessite de modifier la classe TDragControlObjectEx si vous souhaitez afficher l'image déplacée.

Voici la solution proposée :

 
Sélectionnez
{ TImgDragObject }

  TImgDragObject = class(TDragControlObjectEx)
  private
    fDragImages: TDragImageList;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create(AControl: TControl); override;
    destructor Destroy; override;
  end;

[…]

{ TImgDragObject }

function TImgDragObject.GetDragImages: TDragImageList;
// *** images de travail ***
begin
  Result:= fDragImages;
end;

constructor TImgDragObject.Create(AControl: TControl);
// *** création de l'objet de glisser-déposer ***
var
  LBitmap: TBitmap;
begin
  inherited Create(AControl);
  fDragImages := TDragImageList.Create(AControl);
  AlwaysShowDragImages := True;
  fDragImages.Width := (AControl as TImage).Width;
  fDragImages.Height := (AControl as TImage).Height;
  LBitmap := TBitmap.Create;
  try
    LBitmap.SetSize(fDragImages.Width, fDragImages.Height);
    LBitmap.Canvas.StretchDraw((AControl as TImage).ClientRect,
      (AControl as TImage).Picture.Bitmap);
    FDragImages.Add(LBitmap, nil);
  finally
    LBitmap.Free;
  end;
  // pour Linux : FDragImages.DragHotspot := Point(-10,-10);
  FDragImages.DragHotspot := Point(fDragImages.Width div 2,
    fDragImages.Height div 2);
end;

destructor TImgDragObject.Destroy;
// *** destruction de l'objet de glisser-déposer ***
begin
  fDragImages.Free;
  inherited Destroy;
end;

La seule difficulté véritable réside dans la prise en compte de la taille de la portion d'image : afin que l'image en semi-transparence conserve les bonnes proportions, vous devez contrôler ses dimensions grâce à la méthode SetSize et la copier avec la méthode StretchDraw de la propriété Canvas de TBitmap.

Sous Linux, il est rappelé que la méthode DragHotSpot doit être accompagnée de paramètres qui permettent au point de contrôle de se situer en dehors de l'image déplacée.

Pour la mise en œuvre du mécanisme lui-même, il vous faudra faire appel aux gestionnaires habituels :

 
Sélectionnez
procedure TMainForm.Img01DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** une image est déposée ***
var
  L1, L2, LT: Integer;
  LControl: TControl;
begin
  LControl := nil;
  if Source is TControl then
    LControl := Source as TControl
  else
  if Source is TDragControlObject then
    LControl := (Source as TDragControlObject).Control;
  // on intervertit les index
  L1 := StrToInt(RightStr((Sender as TImage).Name, 2)) - 1;
  L2 := StrToInt(RightStr((LControl as TImage).Name, 2)) - 1;
  LT := fArrayOfIndex[L1];
  fArrayOfIndex[L1] := fArrayOfIndex[L2];
  fArrayOfIndex[L2] := LT;
  FreeImages;
  PrepareImages;
  DisplayImages;
end;

procedure TMainForm.Img01DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
// *** acceptation s'il s'agit d'une image différente de celle en cours ***
var
  LControl: TControl;
begin
  LControl := nil;
  if Source is TControl then
    LControl := (Source as TControl)
  else
  if (Source is TDragControlObject) then
    LControl := (Source as TDragControlObject).Control;
  Accept := (LControl is TImage) and (LControl <> Sender);
  fGoodMove := Accept;
end;

procedure TMainForm.Img01EndDrag(Sender, Target: TObject; X, Y: Integer);
// *** s'il s'agit d'un déplacement accepté, on vérifie l'état de la partie ***
var
  LSt: string;
begin
  if fGoodMove then
  begin
    Counter := Counter + 1;
    if IsOk then
    begin
      if Counter > 1 then
        LSt := 'coups'
      else
        LSt := 'coup';
      lblCounter.Caption := Format('Vous avez gagné en %d %s !', [Counter, LSt]);
    end;
  end;
end;

procedure TMainForm.Img01StartDrag(Sender: TObject; var DragObject: TDragObject
  );
// *** le glisser commence ***
begin
  DragObject := TImgDragObject.Create(Sender as TControl);
end;

En dehors de quelques améliorations de détail afin d'afficher le nombre de coups ou de cacher l'image principale, vous avez à présent une application complète pour jouer à reconstituer des images.

D'autres améliorations sont envisageables : le choix de la taille du puzzle, un tableau des meilleurs scores, etc.

V. Conclusion

Avec cet ultime tutoriel sur le glisser-déposer à l'aide de Free Pascal et Lazarus, vous aurez appris à :

  • contrôler de manière précise les curseurs et les images ;
  • maîtriser les appels aux différents gestionnaires d'événements, y compris ceux relatifs à la souris ;
  • réaliser une application complète mettant en Å“uvre les mécanismes étudiés jusqu'alors.

Dorénavant, le glisser-déposer n'ayant plus de secrets véritables pour vous, seule votre pratique fixera une borne à votre imagination !

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