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 :
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 :
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 :
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 :
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 :
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é :
{ 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 :
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 :
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 :
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 :
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é :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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é :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
{ 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 :
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.