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 sera 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 18]
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 :
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 19]
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 auto-gé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 20]
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
);
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.
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énement 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 compliquer 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 21]
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 22]
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 image alternative à 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 portions 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
;
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.
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 !