Drag&Drop sous FiremonKey
Depuis que j'ai un smartphone Android, je prend régulièrement des photos, comme tout le monde. Sauf que ces photos viennent se placer dans le répertoire
ANDRO100
avec des noms génériques qui fait qu'il est pénible de retrouver une photo après coup.J'ai bien tenté de mettre de l'ordre dans ce répertoire depuis l'explorateur Windows, mais allez savoir pourquoi, je rencontre des différences entre ce que m'affiche Windows et ce qu'il y a sur mon smartphone...bref, un développement Android s'imposait et ça tombe bien car je viens de faire l'acquisition d'une licence Delphi XE6 !
Drag&Drop c'est facile !
Le drag&drop n'a plus de secret pour moi depuis longtemps (Delphi 1 ?), donc je colle une TImage
avec sa propriété DragMode
à dmAutomatic
et j'ajoute les événements OnDragOver
et OnDragDrop
sur une combo pour déplacer facilement une image vers un dossier.Après un premier test sous Win32 - puisqu'il est possible maintenant de compiler les applications mobile sous Windows - je constate que ça fonctionne et je peux passer sur Mobile. Et là grosse déception, j'ai beau astiquer le
TImage
, il ne bouge pas d'un poil.Drag&Drop sous Android
Après une analyse en profondeur des sources de la FMX, je constate que le Drag&Drop automatique déclenche un traitement sur la fiche:procedure TCommonCustomForm.BeginInternalDrag(const Source: TObject; const ABitmap: TObject); var D: TDragObject; DDService: IFMXDragDropService; begin if Assigned(Source) then begin Fillchar(D, SizeOf(D), 0); D.Source := Source; if TPlatformServices.Current.SupportsPlatformService(IFMXDragDropService, IInterface(DDService)) then DDService.BeginDragDrop(Self, D, FMX.Graphics.TBitmap(ABitmap)); end; end;
C'est un code inhabituel pour les connaisseurs de la VCL, sauf peut-être pour les développeurs qui ont testé les OTA (OpenTools API) qui permettent d'enrichir l'IDE Delphi. FMX comme les OTA utilise en effet un certain nombre d'
Interface
que l'on vient solliciter au besoin. Ici, manifestement, la plateforme doit supporter le service IFMXDragDropService
sous peine de ne rien "draguer" du tout.Un petit coup de grepWin plus tard, je découvre qu'en effet seuls
FMX.Platform.Win.pas
et FMX.Platform.Mac.pas
implémentent ce service; il n'y a donc pas de drag & drop sous Android et iOS ! Qu'à cela ne tienne, je vais l'ajouter !
Enrichir la plateforme FMX
C'est relativement simple à faire, une seule ligne de code permet d'ajouter le serviceTPlatformServices.Current.AddPlatformService(IFMXDragDropService, ???);
Evidemment, toute la question est de savoir quoi mettre à la place des point d'interrogation :)
L'interface IFMXDragDropService
Cette interface est très (trop) simple, elle ne déclare qu'une seule fonctionIFMXDragDropService = interface(IInterface) ['{73133536-5868-44B6-B02D-7364F75FAD0E}'] procedure BeginDragDrop(AForm: TCommonCustomForm; const Data: TDragObject; ABitmap: TBitmap); end;
c'est donc aussi simple que cela, on ajoute une classe implémentant l'interface et on lui demande de gérer le Drag&Drop...un
TImage
dessiné par dessus la fiche qui capture la souris devrait le faire...en VCL c'était simple avec SetCaptureControl
...qu'est ce que ça donne en FMX ?Problème de capture
Premier problème, SetCaptureControl
n'existe plus, c'est Captured
qui le remplace et son setter est bien évidemment en visibilité protected
...premier hack, on va devoir rusertype TOpenForm = class(TForm) // access to protected method SetCaptured() end; ... TOpenForm(AForm).SetCaptured(FImage); // need an access to TCommonCustoForm.FCaptured
Problème de souris
Deuxième point, il faut placer cette image sous la souris...hors sous Windows la fonction de l'API Windows GetCursorPos
retourne la position de la souris hors contexte, sous mac c'est NSEvent.mouseLocation
qui est utilisé...comment le faire sous Android ?!En fait ça n'existe pas je pense sous Android, mais
TPlatformAndroid
a la bonne idée de fournir la méthode GetMousePos
:function TPlatformAndroid.GetMousePos: TPointF; begin Result := FMouseCoord; end;
Nous voilà avec tous les ingrédients nécessaire pour faire du Drag&Drop crossplatform sous Firemonkey...et ça fonctionne !
Vous noterez cependant deux petites défauts. Quand je clique la première fois sur l'image, l'image semi-transparent apparaît dans le coin de la fenêtre, et quand je la remonte, l'image apparaît exactement à l'endroit ou je l'ai lâchée précédemment.
Ce problème provient de la mise à jour de
FMouseCoord
qui ne se fait pas au moment du MouseDown
qui déclenche le drag&drop, mais dès qu'on bouge le doigt, tout rendre dans l'ordre.Pour corriger ce problème il existe une propriété idéale
TCommonCustomForm.FMousePos
, le seul problème c'est qu'elle est privée. Si on veux un drag&drop parfait, il faut que la fiche parent nous retourne la position de la souris. L'unité Execute.FMXBasedDragDrop.pas
vérifie en premier lieu si la fiche propose l'interface IFMXMouseService
avant d'exploiter celle de TPlatformAndroid
...la modification à faire au niveau de la fiche est des plus simple :{ Fix IFMXMouseService bug on TPlatform because FMouseCoords isn't updated on MouseDown event } function TForm1.GetMousePos: TPointF; begin Result := FMousePos; end; procedure TForm1.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin FMousePos.X := X; FMousePos.Y := Y; inherited; end; procedure TForm1.MouseMove(Shift: TShiftState; X, Y: Single); begin FMousePos.X := X; FMousePos.Y := Y; inherited; end;
et là ça fonctionne parfaitement...et même avec un autre composant pour peu que sa propriété
DragMode
est à dmAutomatic
Unité Execute.FMXBasedDragDrop
Pour finir voici le code complet de l'unité Drag&Drop pour Android (et iOS mais je n'ai pas testé)unit Execute.FMXBasedDragDrop; { FMX based Drag&Drop automatic mode for Delphi XE6 (c)2014 by Execute SARL FMX lacks support for Drag & Drop for Android, this unit adds a Drag & Drop crossplatform solution that should work on Android and iOS. Paul TOTH http://www.execute.re } interface uses System.Types; implementation uses System.Classes, System.UITypes, FMX.Platform, FMX.Objects, FMX.Types, FMX.Forms, FMX.Graphics; type TOpenForm = class(TForm) // access to protected method SetCaptured() end; // the dragged image TDragImage = class(TImage) private FMouse : IFMXMouseService; FOrigin : TPointF; FData : TDragObject; FOperation: TDragOperation; protected procedure MouseMove(Shift: TShiftState; X, Y: Single); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; end; // the missing service TFMXDragDrop = class(TInterfacedObject, IFMXDragDropService) private FImage : TDragImage; public destructor Destroy; override; procedure BeginDragDrop(AForm: TCommonCustomForm; const Data: TDragObject; ABitmap: TBitmap); end; // move the dragged image with mouse movement procedure TDragImage.MouseMove(Shift: TShiftState; X: Single; Y: Single); var MousePos: TPointF; begin MousePos := FMouse.GetMousePos; // we need a Form based mouse position, not the local one Position.X := FOrigin.X + MousePos.X; Position.Y := FOrigin.Y + MousePos.Y; FOperation := TDragOperation.None; HitTest := False; // don't see me TForm(Parent).DragOver(FData, FMouse.GetMousePos, FOperation); HitTest := True; // see me end; // drop the dragged image somewhere procedure TDragImage.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); begin if FOperation <> TDragOperation.None then begin HitTest := False; // don't see me TForm(Parent).DragDrop(FData, FMouse.GetMousePos); HitTest := True; // see me end; Parent := nil; end; destructor TFMXDragDrop.Destroy; begin FImage.Free; inherited; end; procedure TFMXDragDrop.BeginDragDrop(AForm: TCommonCustomForm; const Data: TDragObject; ABitmap: TBitmap); var Mouse: IFMXMouseService; begin if FImage = nil then begin // the mouse position is not available, TCommonCustomForm.FMousePos would be a good candidate if it was not private // request the IFMXMouseService on the TForm to see if it is provided if IInterface(AForm).QueryInterface(IFMXMouseService, Mouse) <> 0 then begin // now request the TPlatform, but this one is not updated when MouseDown occurs and the first image position will be wrong if not TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, IInterface(Mouse)) then Exit; end; FImage := TDragImage.Create(nil); FImage.FMouse := Mouse; end; FImage.Parent := AForm; FImage.FData := Data; FImage.FOrigin := FImage.FMouse.GetMousePos(); // AForm.FMousePos would be great FImage.SetBounds( FImage.FOrigin.X - ABitmap.Width/2, FImage.FOrigin.Y - ABitmap.Height/2, ABitmap.Width, ABitmap.Height ); FImage.Bitmap.Assign(ABitmap); FImage.Opacity := 0.5; FImage.FOrigin.X := FImage.Position.X - FImage.FOrigin.X; FImage.FOrigin.Y := FImage.Position.Y - FImage.FOrigin.Y; TOpenForm(AForm).SetCaptured(FImage); // need an access to TCommonCustoForm.FCaptured end; initialization // Register the DragDrop service // on Windows & Mac the service is already registered and this unit is useless TPlatformServices.Current.AddPlatformService(IFMXDragDropService, TFMXDragDrop.Create); end.
Vous pouvez également télécharge l'unité et son projet exemple
zip/FMXBasedDragDrop.zip
Date de dernière modification : 24/05/2014