I. Introduction▲
Les programmes de test sont présents dans le répertoire exemples accompagnant le présent document.
Vous savez utiliser le glisser-déposer au sein d'un contrôle, entre des contrôles et même entre les fenêtres d'une même application. Cependant, vous considérez que le mécanisme mis à votre disposition ne correspond pas tout à fait à vos attentes : vous aimeriez une autre icône lors du déplacement, ou utiliser le bouton droit de la souris, ou encore ne l'embrayer qu'après un mouvement significatif de cette même souris... Qu'à cela ne tienne : Lazarus sait répondre à ce genre de situations !
L'exposé qui suit vous aidera à personnaliser vos applications qui utiliseront le glisser-déposer. Il vous proposera des méthodes souvent utiles parmi lesquelles vous choisirez celles qui vous paraîtront les plus pertinentes aux problèmes réels posés.
II. Petits arrangements entre amis▲
II-A. Utiliser les propriétés de l'application▲
Avant de se pencher sur l'échange d'informations à partir de contrôles, il peut être utile de savoir que l'accès à des fichiers depuis un gestionnaire de fichiers est susceptible d'être centralisé grâce au composant TApplicationProperties issu du volet « Additional » des composants. En effet, ce composant non visuel a été créé afin de faciliter la gestion de différents paramètres de l'application qui l'utilise : il fournit en particulier la possibilité d'écrire un gestionnaire OnDropFiles qui sera appliqué à toutes les fenêtres qui auront leur propriété AllowDropFiles à True, donc sans avoir besoin d'être dupliqué.
[Exemple DragAndDrop 09]
Pour le tester, vous allez créer une application qui va afficher les fichiers de type Pascal comme vous l'aviez déjà fait dans le tutoriel précédent. À la différence de cet exemple, les fichiers pourront être glissés aussi bien sur la fiche principale qui abritera l'éditeur que sur une seconde fenêtre apparemment sans rôle : en effet, elle n'aura que sa propriété AllowDropFiles passée à True, et rien d'autre !
Voici l'interface utilisateur proposée :
La fiche principale (MainForm) comprend un composant TSynEdit (baptisé SynEditMain) pour l'édition et son compagnon de coloration syntaxique TSynPasSyn (SynPasSynMain). L'éditeur a sa propriété Align passée à alClient afin d'occuper tout l'espace de la fiche. Bien sûr, la propriété AllowDropFiles de cette même fiche est à True.
Surtout, vous devez ajouter un composant TApplicationProperties que vous renommerez en ApplicationPropertiesMain. Depuis l'onglet « Événements » de l'inspecteur d'objet positionné sur ce composant, vous créerez simplement un gestionnaire OnDropFiles ainsi :
procedure TMainForm.ApplicationPropertiesMainDropFiles(Sender: TObject;
const FileNames: array of String);
// *** chargement si possible ***
begin
if IsPascalSource(FileNames[0]) then
SynEditMain.Lines.LoadFromFile(FileNames[0])
else
MessageDlg('Chargement d''un fichier',
'Le fichier choisi n''est pas un fichier Pascal !', mtError, [mbOK], 0);
end;Vous reconnaîtrez le gestionnaire déjà rédigé pour l'ancien exemple, mais attribué cette fois-ci au composant de centralisation et non à la fiche elle-même.
La seconde fiche (SecondForm) a une bordure (BorderStyle) positionnée en bsDialog et sera affichée sans icônes : toutes les sous-propriétés de BorderIcons sont à False. Il ne s'agit que d'un choix arbitraire pour une présentation plus soignée et qui n'influe en rien le comportement du glisser-déposer. En revanche, cette fiche doit impérativement elle aussi avoir sa propriété AllowDropFiles à True. L'unité afférente ne comprendra aucun code autre que celui créé automatiquement par Lazarus, même pas une référence à la fiche principale !
Le fichier LFM qui lui correspond aura cette allure :
object SecondForm: TSecondForm
Left = 826
Height = 84
Top = 141
Width = 217
AllowDropFiles = True
BorderIcons = []
BorderStyle = bsDialog
Caption = 'J''aime Pascal !'
LCLVersion = '1.6.4.0'
endDans la fiche principale, vous commanderez l'affichage de la seconde fiche via le gestionnaire OnShow, par exemple, sans oublier de définir la méthode IsPascalSource pour la validation de la prise en compte des fichiers déposés.
Le code source de la fiche principale ressemblera finalement à ceci :
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, SynEdit, SynHighlighterMulti, SynHighlighterPas,
Forms, Controls, Graphics, Dialogs;
const
PascalExt: array[1..6] of string = ('.pas','.pp','.p','.lpr','.dpr','.dpk');
type
{ TMainForm }
TMainForm = class(TForm)
ApplicationPropertiesMain: TApplicationProperties;
SynEditMain: TSynEdit;
SynPasSynMain: TSynPasSyn;
procedure ApplicationPropertiesMainDropFiles(Sender: TObject;
const FileNames: array of String);
procedure FormShow(Sender: TObject);
private
{ private declarations }
function IsPascalSource(const AFile: string): Boolean;
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
uses
LazFileUtils, second;
{$R *.lfm}
procedure TMainForm.ApplicationPropertiesMainDropFiles(Sender: TObject;
const FileNames: array of String);
// *** chargement si possible ***
begin
if IsPascalSource(FileNames[0]) then
SynEditMain.Lines.LoadFromFile(FileNames[0])
else
MessageDlg('Chargement d''un fichier',
'Le fichier choisi n''est pas un fichier Pascal !', mtError, [mbOK], 0);
end;
procedure TMainForm.FormShow(Sender: TObject);
// *** affichage de la seconde fiche ***
begin
SecondForm.Show;
end;
function TMainForm.IsPascalSource(const AFile: string): Boolean;
// *** un fichier Pascal ? ***
var
Li: Integer;
begin
if FileIsText(AFile) then
for Li := Low(PascalExt) to High(PascalExt) do
if CompareFileExt(AFile, PascalExt[Li]) = 0 then
Exit(True);
Result := False;
end;
end.Dorénavant, à l'exécution de cette application, les fichiers de type Pascal seront listés sur la fenêtre principale, qu'ils aient indifféremment été déposés sur cette fiche ou sur sa petite sœur squelettique !
II-B. Choisir le bouton actif de la souris▲
Revenant au cas plus riche du glisser-déposer avec des contrôles d'une fiche, vous allez à présent apprendre à personnaliser certains aspects de ce mécanisme. Pour commencer, vous allez décider quelle action sur la souris le déclenchera.
[Exemple DragAndDrop 10]
Déjà, vous allez reprendre l'échange de deux images selon l'interface utilisateur suivante :
Dans deux TGroupBox, vous aurez placé une TImage dont la propriété Stretch aura été mise à True pour circonscrire l'image contenue.
Les gestionnaires d'événements OnDragOver et OnDragDrop seront ceux utilisés précédemment :
procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
Accept := (Source = Image1) or (Source = Image2);
end;
procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** le contrôle est lâché = > on échange les images ***
var
LPct: TPicture;
begin
LPct := TPicture.Create;
try
LPct.Assign((Sender as TImage).Picture);
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
(Source as TImage).Picture.Assign(LPct);
finally
LPct.Free;
end;
end;Vous prendrez soin de les connecter aux deux images afin d'autoriser les échanges.
En revanche, vous ne mettrez pas la propriété DragMode des TImage à dmAutomatic, mais vous la laisserez à dmManual. Ainsi vous garderez un véritable contrôle du mécanisme de glisser-déposer.
Comme premier exemple de ce contrôle amélioré, vous pouvez décider de lancer le glisser lorsque l'utilisateur aura maintenu pressé le bouton droit de la souris. C'est par conséquent au nouveau gestionnaire OnMouseDown que vous allez faire appel en l'associant encore une fois aux deux TImage :
procedure TMainForm.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// *** lancement du glisser ? ***
begin
if (Sender is TImage) and (Button = mbRight) then
(Sender as TImage).BeginDrag(True);
end;Comme le glisser a été rendu manuel, il faut explicitement le déclencher : c'est l'objectif de la méthode BeginDrag dont le paramètre est mis à True afin de lancer directement le mécanisme.
Les tests au sein du gestionnaire sont facilement compréhensibles : s'il s'agit d'une image et que le bouton droit de la souris est pressé, alors on doit lancer le glisser lié à cette image.
II-C. Prévoir un seuil avant le déclenchement▲
Toujours dans le même esprit de personnalisation, il peut être utile de ne passer en mode glisser qu'après un certain déplacement de la souris. Par exemple, au sein d'un TEdit, tout mouvement ne signifie pas forcément un glisser-déposer : l'utilisateur doit aussi pouvoir saisir des données !
Pour ce faire, la méthode BeginDrag cache un second paramètre baptisé Threhold : il définit le nombre de pixels que doit parcourir la souris pour que le mouvement soit considéré comme un glisser-déposer. S'il n'apparaissait pas dans l'exemple précédent, c'est qu'il a une valeur par défaut de -1 qui correspond à une valeur définie en dur de 5 pixels avant déclenchement.
En reprenant le système d'échange d'images, vous aurez peu de choses à modifier pour tester cette nouvelle possibilité.
[Exemple DragAndDrop 11]
En fait, après avoir ajouté un composant TSpinEdit (baptisé seThrehold) à la fiche principale, deux possibilités s'offriront à vous :
- passer le paramètre de BeginDrag à False puis associer un gestionnaire OnChange au TSpinEdit pour modifier grâce à lui la propriété DragThrehold de l'objet global Mouse qui gouverne la souris ;
- comme indiqué en premier lieu, fournir directement la valeur du paramètre caché de BeginDrag à partir de celle du TSpinEdit.
Ce sont ces options qu'illustre le listing suivant :
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, Spin;
type
{ TMainForm }
TMainForm = class(TForm)
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Image1: TImage;
Image2: TImage;
lblThrehold: TLabel;
seThrehold: TSpinEdit;
procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
{%H-}State: TDragState; var Accept: Boolean);
procedure seThreholdChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
Accept := (Source = Image1) or (Source = Image2);
end;
procedure TMainForm.seThreholdChange(Sender: TObject);
// *** seuil avant déplacement ***
begin
Mouse.DragThreshold := seThrehold.Value; // à commenter (option 2)
end;
procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** le contrôle est lâché = > on échange les images ***
var
LPct: TPicture;
begin
LPct := TPicture.Create;
try
LPct.Assign((Sender as TImage).Picture);
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
(Source as TImage).Picture.Assign(LPct);
finally
LPct.Free;
end;
end;
procedure TMainForm.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// *** lancement du glisser ? ***
begin
if (Sender is TImage) and (Button = mbRight) then
(Sender as TImage).BeginDrag(False); // changement !
// (Sender as TImage).BeginDrag(False, seThrehold.Value); // autre possibilité
end;
end.Plus le seuil de déclenchement sera élevé, plus il sera facile de mesurer son effet. Voici un instantané pris de l'application en cours d'exécution :
Parmi les propriétés de la classe TMouse, DragImmediate offre encore une variante : si elle vaut False, elle devient l'équivalent du paramètre de BeginDrag à False lui aussi. Ainsi le déclenchement sera-t-il aussi différé tant que la longueur Threhold ne sera pas franchie avec la souris.
[Exemple DragAndDrop 12]
Cette option ne modifie guère l'exemple précédent : vous ajouterez seulement une TCheckBox (nommée cbDragImmediate) pour associer grâce à un gestionnaire OnChange une valeur booléenne à la propriété DragImmediate de l'objet Mouse.
Voici le code source de l'unité de la fiche principale :
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, Spin;
type
{ TMainForm }
TMainForm = class(TForm)
cbDragImmediate: TCheckBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Image1: TImage;
Image2: TImage;
lblThrehold: TLabel;
seThrehold: TSpinEdit;
procedure cbDragImmediateChange(Sender: TObject);
procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
{%H-}State: TDragState; var Accept: Boolean);
procedure seThreholdChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
Accept := (Source = Image1) or (Source = Image2);
end;
procedure TMainForm.seThreholdChange(Sender: TObject);
// *** seuil avant déplacement ***
begin
Mouse.DragThreshold := seThrehold.Value;
end;
procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** le contrôle est lâché = > on échange les images ***
var
LPct: TPicture;
begin
LPct := TPicture.Create;
try
LPct.Assign((Sender as TImage).Picture);
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
(Source as TImage).Picture.Assign(LPct);
finally
LPct.Free;
end;
end;
procedure TMainForm.cbDragImmediateChange(Sender: TObject);
// *** déplacement immédiat ? ***
begin
Mouse.DragImmediate := cbDragImmediate.Checked;
end;
end.L'ensemble est bien plus cohérent puisque toute la personnalisation passe par l'objet Mouse à travers deux de ses propriétés, à savoir DragImmediate et DragThrehold. Vous pourrez toujours préférer utiliser la méthode BeginDrag en adaptant ses deux paramètres à vos besoins.
À l'exécution, en dehors de l'action introduite par le nouveau composant, rien ne change si ce n'est le contrôle de l'immédiateté du glisser-déposer :
II-D. Forcer le glisser-déposer▲
Toujours dans le domaine des méthodes fort utiles, il en est une qui permet de simuler un glisser-déposer. Associée à un contrôle autorisant le glisser-déposer, cette méthode prend pour paramètres l'objet à exploiter pour déposer et deux entiers pour indiquer à quelle position doit aboutir le dépôt.
[Exemple DragAndDrop 13]
Afin de mieux vous rendre compte quelle souplesse nouvelle apporte cette méthode, vous allez créer une nouvelle application qui apparaît comme une version simplifiée des précédentes. En voici l'interface utilisateur :
L'image sera simplement recopiée dans l'espace vide juxtaposé. Pour cela, vous passerez à dmAutomatic la propriété DragMode de Image1, puis vous saisirez le code suivant :
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
type
{ TMainForm }
TMainForm = class(TForm)
btnCopy: TButton;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Image1: TImage;
Image2: TImage;
procedure btnCopyClick(Sender: TObject);
procedure Image2DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.btnCopyClick(Sender: TObject);
// *** glisser déposer forcé ***
begin
Image2.DragDrop(Image1, 0, 0);
end;
procedure TMainForm.Image2DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** lâcher sur l'image 2 ***
begin
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
end;
end.Si le gestionnaire OnDragDrop est celui conçu habituellement, vous voyez qu'un clic sur le bouton « Copier » exécute la méthode DragDrop liée à Image2 (donc la destination) à partir de la source indiquée en paramètre (ici, Image1). Il est ainsi possible de court-circuiter le glisser-déposer tout en utilisant le même gestionnaire OnDragDrop.
II-E. Savoir si un glisser-déposer est en cours▲
Parfois, il est nécessaire de savoir si une opération de glisser-déposer est en cours. Imaginez par exemple certaines commandes à activer ou désactiver. Encore une fois, une simple méthode associée aux contrôles et renvoyant un booléen fera l'affaire : il s'agit de Dragging.
[Exemple DragAndDrop 14]
Toujours à partir des deux images à permuter, vous pouvez enrichir l'application de test en adaptant le statut d'un bouton au glisser-déposer éventuellement en cours. Vous n'avez qu'à ajouter un TButton (renommé btnDummy) et un composant non visuel TActionList (renommé ActionList) pour la gestion des actions.
À partir de ce dernier, vous créerez une nouvelle action baptisée ActionButton, ainsi que deux gestionnaires liés à cette dernière : OnExecute et OnUpdate.
Le code de ces gestionnaires ne pose pas de problèmes particuliers :
procedure TMainForm.ActionButtonUpdate(Sender: TObject);
// *** désactivation si déplacement en cours ***
begin
btnDummy.Enabled := not (Image1.Dragging or Image2.Dragging);
end;
procedure TMainForm.ActionButtonExecute(Sender: TObject);
// *** action liée au clic sur le bouton ***
begin
MessageDlg('', 'Le bouton a été cliqué !', mtInformation, [mbOK], 0);
end;Comme annoncé, il s'agit de mettre à l'épreuve la méthode Dragging : le bouton ne sera activé que si aucune des images ne sera en cours de glisser-déposer. Quant au clic sur le bouton, s'il est actif, il provoquera l'affichage d'une boîte de dialogue rudimentaire.
Pour le reste, vous retrouverez la machinerie qui vous est dorénavant familière :
Le code source de la fiche principale est fourni ci-après :
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ActnList;
type
{ TMainForm }
TMainForm = class(TForm)
ActionButton: TAction;
ActionList: TActionList;
btnDummy: TButton;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Image1: TImage;
Image2: TImage;
procedure ActionButtonExecute(Sender: TObject);
procedure ActionButtonUpdate(Sender: TObject);
procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
{%H-}State: TDragState; var Accept: Boolean);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
Accept := (Source = Image1) or (Source = Image2);
end;
procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** le contrôle est lâché = > on échange les images ***
var
LPct: TPicture;
begin
LPct := TPicture.Create;
try
LPct.Assign((Sender as TImage).Picture);
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
(Source as TImage).Picture.Assign(LPct);
finally
LPct.Free;
end;
end;
procedure TMainForm.ActionButtonUpdate(Sender: TObject);
// *** désactivation si déplacement en cours ***
begin
btnDummy.Enabled := not (Image1.Dragging or Image2.Dragging);
end;
procedure TMainForm.ActionButtonExecute(Sender: TObject);
// *** action liée au clic sur le bouton ***
begin
MessageDlg('', 'Le bouton a été cliqué !', mtInformation, [mbOK], 0);
end;
end.L'application en action fournira ce genre de copie d'écran sur laquelle vous remarquerez le bouton désactivé puisqu'une opération de glisser-déposer est en cours :
[Exemple DragAndDrop 15]
Plus généralement, si votre fiche active a besoin de savoir si une opération de glisser-déposer est en cours, il vous faudra parcourir les contrôles présents et étudier la valeur retournée par la fonction Dragging qui leur correspond.
Voici une méthode applicable à cette fin :
function TMainForm.IsDragging: Boolean;
// *** une opération de glisser-déplacer est-elle en cours ? ***
var
Li: Integer;
begin
Result := False;
for Li := 0 to ComponentCount - 1 do
if (Components[Li] is TControl) and (Components[Li] as TControl).Dragging then
begin
Result := True;
Break;
end;
end;La liste des composants de la fiche est parcourue. Si le composant en cours est un descendant de TControl , on vérifie grâce à sa méthode Dragging s'il est en cours de glisser-déposer. La boucle est interrompue dès le premier test positif.
Du coup, l'activité du bouton de l'exemple précédent change un peu de forme :
procedure TMainForm.ActionButtonUpdate(Sender: TObject);
// *** désactivation si déplacement en cours ***
begin
btnDummy.Enabled := not IsDragging;
end;L'avantage de cette façon de faire est qu'elle est bien plus générale. Il faudra cependant faire attention à ne pas ralentir l'application avec un trop grand nombre de composants présents.
II-F. Identifier une cible▲
Une autre fonctionnalité peut s'avérer nécessaire : identifier la cible potentielle d'un glisser-déposer. Pour cela, une fois n'est pas coutume, il est suggéré d'utiliser une fonction globale : FindDropTarget .
Cette fonction de l'unité Controls identifie le contrôle présent à une position donnée de l'application et renvoie un résultat de type TControl (ou nil si aucun contrôle n'est présent sous le curseur). En fait, il ne s'agit que d'un double de la fonction FindControlAtPosition :
function FindDragTarget(const Position: TPoint; AllowDisabled: Boolean): TControl;
function FindControlAtPosition(const Position: TPoint; AllowDisabled: Boolean): TControl;Les coordonnées fournies le sont relativement à l'écran. Le second paramètre n'est pour le moment pas pris en compte et devrait toujours être à False.
[Exemple DragAndDrop 16]
Même si elle est plutôt limitée, cette fonction peut rendre quelques services. Voici par exemple son intervention dans l'application d'échanges d'images :
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls;
type
{ TMainForm }
TMainForm = class(TForm)
ApplicationProperties: TApplicationProperties;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Image1: TImage;
Image2: TImage;
lblOver: TLabel;
procedure ApplicationPropertiesIdle(Sender: TObject; var {%H-}Done: Boolean);
procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
{%H-}State: TDragState; var Accept: Boolean);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
Accept := (Source = Image1) or (Source = Image2);
end;
procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** le contrôle est lâché = > on échange les images ***
var
LPct: TPicture;
begin
LPct := TPicture.Create;
try
LPct.Assign((Sender as TImage).Picture);
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
(Source as TImage).Picture.Assign(LPct);
finally
LPct.Free;
end;
end;
procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean
);
// *** contrôle survolé ***
var
LControl: TControl;
begin
LControl := FindDragTarget(Mouse.CursorPos, False);
if LControl <> nil then
LblOver.Caption := LControl.ClassName;
end;
end.La mise en œuvre de la fonction FindDropTarget peut se faire, comme dans l'exemple proposé, grâce au gestionnaire OnIdle du composant TApplicationProperties qui gère les propriétés globales d'une application. Plus exactement, ce gestionnaire effectue des tâches lorsque l'application n'a rien à faire. On voit qu'ici, si un contrôle est repéré à la position de la souris, son nom de classe est affecté au libellé d'une étiquette baptisée lblOver.
II-G. Contrôler l'état du glisser-déposer▲
Pour clore ce tour d'horizon des outils de personnalisation offerts par Lazarus, vous allez vous servir d'un paramètre jusque là inexploité du gestionnaire de OnDragOver. En effet, State vérifie l'état de la souris survolant un contrôle prêt à accepter le dépôt de données. Il devient possible de distinguer l'entrée de la souris, son survol et sa sortie du contrôle visé, d'où des réactions envisageables comme des messages d'alerte, des animations, des calculs, etc.
Voici les trois états définis :
TDragState = (dsDragEnter, dsDragLeave, dsDragMove);[Exemple DragAndDrop 17]
Dans l'exemple proposé, vous vous contenterez, toujours à partir de la trame de deux images à échanger, de modifier le libellé d'un TLabel baptisé lblState.
Le code source ne pose a priori aucun problème particulier :
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls;
type
{ TMainForm }
TMainForm = class(TForm)
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Image1: TImage;
Image2: TImage;
lblState: TLabel;
procedure Image1DragDrop(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer);
procedure Image2DragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
{%H-}State: TDragState; var Accept: Boolean);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
Accept := (Source = Image1) or (Source = Image2);
case State of
dsDragEnter: lblState.Caption := Format('%s entre sur %s', [(Source as TImage).Name,
(Sender as TImage).Name]);
dsDragLeave: lblState.Caption := Format('%s quitte %s', [(Source as TImage).Name,
(Sender as TImage).Name]);
dsDragMove: lblState.Caption := Format('%s se déplace sur %s', [(Source as TImage).Name,
(Sender as TImage).Name]);
end;
end;
procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** le contrôle est lâché = > on échange les images ***
var
LPct: TPicture;
begin
LPct := TPicture.Create;
try
LPct.Assign((Sender as TImage).Picture);
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
(Source as TImage).Picture.Assign(LPct);
finally
LPct.Free;
end;
end;
end.Lors de l'exécution, vous constaterez que le paramètre State renvoie correctement les trois états dont il est supposé rendre compte :
Si vous souhaitez aller plus loin dans la mesure des paramètres du glisser-déposer, vous n'aurez qu'à utiliser les paramètres X et Y des gestionnaires OnDragOver et OnDragDrop. Rien n'empêche de travailler au pixel près et de réagir différemment suivant les coordonnées exactes du point de dépôt.
[Exemple DragAndDrop 18]
Si vous reprenez l'exemple précédent, il suffit de lui adjoindre deux TLabel pour relever les coordonnées renvoyées par les gestionnaires cités. Le code source de l'unité principale n'est donc enrichie que de deux lignes :
procedure TMainForm.Image2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
// *** acceptation ou refus du contrôle ***
begin
Accept := (Source = Image1) or (Source = Image2);
case State of
dsDragEnter: lblState.Caption := Format('%s entre sur %s', [(Source as TImage).Name,
(Sender as TImage).Name]);
dsDragLeave: lblState.Caption := Format('%s quitte %s', [(Source as TImage).Name,
(Sender as TImage).Name]);
dsDragMove: lblState.Caption := Format('%s se déplace sur %s', [(Source as TImage).Name,
(Sender as TImage).Name]);
end;
// AJOUT !!!
lblOver.Caption := Format('OnDragOver : %d:%d', [X, Y]);
end;
procedure TMainForm.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
// *** le contrôle est lâché = > on échange les images ***
var
LPct: TPicture;
begin
LPct := TPicture.Create;
try
LPct.Assign((Sender as TImage).Picture);
(Sender as TImage).Picture.Assign((Source as TImage).Picture);
(Source as TImage).Picture.Assign(LPct);
finally
LPct.Free;
end;
// AJOUT !!!
lblDrop.Caption := Format('OnDragDrop : %d:%d', [X, Y]);
end;
end.Vous n'aurez que formater un court message pour chacun des gestionnaires.
L'exécution pourra donner lieu à des affichages comme le suivant :
Ce qu'il est important de noter :
- les coordonnées X et Y de OnDragOver et de OnDragDrop ne sont bien évidemment récupérables que lors de l'activation des gestionnaires, c'est-à-dire lorsqu'ils sont appelés ;
- les coordonnées X et Y sont fournies en fonction de la zone client du contrôle survolé et non en fonction de l'écran ou de la fenêtre activée ;
- OnDragOver est appelé très souvent alors que OnDragDrop n'est appelé qu'à l'issue d'un dépôt.
III. Conclusion▲
Avec ce tutoriel, vous aurez appris à personnaliser le glisser-déposer standard tel qu'il avait été présenté dans la première partie.
Désormais, vous savez :
- utiliser les propriétés centralisées d'une application ;
- personnaliser le bouton actif de la souris ;
- prévoir un seuil avant le déclenchement du mécanisme de glisser-déposer ;
- savoir si un glisser-déposer est en cours ;
- vérifier finement le déplacement de la souris au-dessus d'un contrôle.
Vous êtes prêt pour approfondir ces connaissances et vous lancer dans des défis plus importants, ce que proposera le dernier volet de cette série de tutoriels sur le glisser-déposer avec Lazarus.