Intégration du Glisser-Déposer de Texte et de Fichiers dans un Contrôle Éditable Delphi

L'intégration de la fonctionnalité de glisser-déposer (drag-and-drop) externe est une exigence courante pour les applications de bureau modernes, permettant aux utilisateurs d'interagir intuitivement avec le programme. Cet article explore comment implémenter la réception de fichiers et de texte par glisser-déposer dans des composants d'édition de texte sous Delphi, en s'appuyant sur les mécanismes du système d'exploitation Windows.

Deux approches principales sont nécessaires pour gérer les différents types de données que l'utilisateur pourrait déposer :

Pour les fichiers : L'interception du message Windows WM_DROPFILES est la méthode standard pour recevoir des chemins de fichiers.
Pour le texte ou d'autres formats de données complexes : L'implémentation de l'interface COM IDropTarget est indispensable pour une gestion plus sophistiquée des données transférées.

Implémentation personnalisée pour un composant TMemo

Pour démontrer cette fonctionnalité, nous allons créer un composant TMemo amélioré, capable d'accepter à la fois des fichiers et du texte glissés depuis l'extérieur de l'application. Ce nouveau composant, que nous nommerons TMemoGlisserDeposer, héritera de TMemo et implémentera les interfaces COM IUnknown et IDropTarget.


type
 TMemoGlisserDeposer = class(TMemo, IUnknown, IDropTarget)
 private
   FSupporteDepot: Boolean; // Indique si la fonctionnalité de glisser-déposer est active
   FValidationFormat: HResult; // Stocke le résultat de la validation de format pour le texte
   FFormatDonneesCible: TFormatEtc; // Décrit le format de données de texte attendu
   FCompteurReferences: Integer; // Compteur de références pour l'interface IUnknown
 protected
   procedure GererFichiersDeposes(var Msg: TWMDropFiles); message WM_DROPFILES;
   procedure ActiverSupportDepot(const P_Valeur: Boolean);

   // Méthodes de l'interface IUnknown
   function QueryInterface(const IID: TGUID; out P_Obj: Pointer): HResult; stdcall;
   function _AddRef: Integer; stdcall;
   function _Release: Integer; stdcall;

   // Méthodes de l'interface IDropTarget
   function DragEnter(const P_DataObject: IDataObject; P_CleEtat: Longint;
     P_Position: TPoint; var P_EffetDepot: Longint): HResult; stdcall;
   function DragOver(P_CleEtat: Longint; P_Position: TPoint;
     var P_EffetDepot: Longint): HResult; stdcall;
   function DragLeave: HResult; stdcall;
   function Drop(const P_DataObject: IDataObject; P_CleEtat: Longint; P_Position: TPoint;
     var P_EffetDepot: Longint): HResult; stdcall;
 public
   property SupporteDepot: Boolean read FSupporteDepot write ActiverSupportDepot;
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 end;

{ TMemoGlisserDeposer implémentation }

constructor TMemoGlisserDeposer.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FCompteurReferences := 0; // Initialiser le compteur de références COM
 FSupporteDepot := False; // Le glisser-déposer est désactivé par défaut
end;

destructor TMemoGlisserDeposer.Destroy;
begin
 // S'assurer de révoquer le support de glisser-déposer si l'objet est toujours enregistré
 if FSupporteDepot then
   RevokeDragDrop(Handle);
 inherited;
end;

procedure TMemoGlisserDeposer.ActiverSupportDepot(const P_Valeur: Boolean);
begin
 if FSupporteDepot = P_Valeur then Exit; // Aucun changement d'état

 FSupporteDepot := P_Valeur;

 // Enregistrer ou désenregistrer le support du dépôt de fichiers (WM_DROPFILES)
 DragAcceptFiles(Handle, FSupporteDepot);

 // Enregistrer ou désenregistrer le support du dépôt de texte (IDropTarget)
 if FSupporteDepot then
   RegisterDragDrop(Handle, Self) // Enregistre cet objet comme cible de dépôt
 else
   RevokeDragDrop(Handle); // Révoque l'enregistrement
end;

procedure TMemoGlisserDeposer.GererFichiersDeposes(var Msg: TWMDropFiles);
var
 LNomFichierBuffer: array[0..MAX_PATH] of Char; // Buffer pour le chemin du fichier
 LCompteurFichiers: Cardinal;
 LCheminComplet: string;
begin
 with Msg do
 begin
   // Récupérer le nombre de fichiers déposés (le dernier paramètre doit être nil pour le décompte)
   LCompteurFichiers := DragQueryFile(Drop, $FFFFFFFF, nil, 0);
   if LCompteurFichiers = 0 then
     Exit; // Aucun fichier détecté

   // Dans cet exemple, nous traitons uniquement le premier fichier déposé
   DragQueryFile(Drop, 0, LNomFichierBuffer, SizeOf(LNomFichierBuffer));
   LCheminComplet := LNomFichierBuffer;
   DragFinish(Drop); // Libérer les ressources allouées pour l'opération de dépôt

   // Charger le contenu du fichier dans le composant Memo
   Lines.LoadFromFile(LCheminComplet);
 end;
end;

function TMemoGlisserDeposer.DragEnter(const P_DataObject: IDataObject; P_CleEtat: Integer;
 P_Position: TPoint; var P_EffetDepot: Integer): HResult;
begin
 Result := E_FAIL;
 FValidationFormat := E_FAIL; // Réinitialiser l'état de validation

 if not FSupporteDepot then
   Exit; // Le glisser-déposer n'est pas actif

 if not Assigned(P_DataObject) then
   Exit; // Aucun objet de données fourni

 // Configurer le format de données attendu : texte
 with FFormatDonneesCible do
 begin
{$IFDEF UNICODE}
   cfFormat := CF_UNICODETEXT; // Préférer le texte Unicode pour les systèmes modernes
{$ELSE}
   cfFormat := CF_TEXT; // Revenir au texte ANSI si nécessaire
{$ENDIF}
   ptd := nil; // Pas de données de périphérique cibles
   dwAspect := DVASPECT_CONTENT; // Affichage normal du contenu
   lindex := -1; // Toutes les données sont concernées
   tymed := TYMED_HGLOBAL; // Les données sont transférées via un handle mémoire global
 end;

 // Vérifier si l'objet de données peut fournir les données dans le format spécifié
 FValidationFormat := P_DataObject.QueryGetData(FFormatDonneesCible);
 Result := FValidationFormat;

 if Succeeded(Result) then // Si le format est supporté
   P_EffetDepot := DROPEFFECT_COPY // Indiquer une action de copie
 else
   P_EffetDepot := DROPEFFECT_NONE; // Aucune action possible
end;

function TMemoGlisserDeposer.DragOver(P_CleEtat: Integer; P_Position: TPoint; var P_EffetDepot: Integer): HResult;
begin
 // Le traitement ici est généralement léger, l'effet de dépôt est souvent déterminé par DragEnter
 Result := S_OK;
end;

function TMemoGlisserDeposer.DragLeave: HResult;
begin
 FValidationFormat := E_FAIL; // Réinitialiser l'état lors du départ du curseur
 Result := S_OK;
end;

function TMemoGlisserDeposer.Drop(const P_DataObject: IDataObject; P_CleEtat: Integer; P_Position: TPoint;
 var P_EffetDepot: Integer): HResult;
var
 LMediumDonnees: TStgMedium;
 LHandleDonnees: HGLOBAL;
 LTexteRecu: PChar;
begin
 Result := E_FAIL;

 if Failed(FValidationFormat) then
   Exit; // Le format de données n'a pas été validé précédemment

 // Obtenir les données dans le format spécifié par FFormatDonneesCible
 Result := P_DataObject.GetData(FFormatDonneesCible, LMediumDonnees);
 if Failed(Result) then
 begin
   ReleaseStgMedium(LMediumDonnees); // S'assurer de libérer le medium en cas d'échec
   Exit;
 end;

 // Verrouiller le handle global pour accéder aux données
 LHandleDonnees := HGLOBAL(GlobalLock(LMediumDonnees.hGlobal));
 if LHandleDonnees = 0 then
 begin
   ReleaseStgMedium(LMediumDonnees); // Libérer le medium si le verrouillage échoue
   Exit;
 end;

 try
   LTexteRecu := PChar(LHandleDonnees);
   // Assigner le texte reçu au composant Memo
   Lines.Text := LTexteRecu;
   P_EffetDepot := DROPEFFECT_COPY; // Confirmer que l'opération de copie a eu lieu
 finally
   GlobalUnlock(LMediumDonnees.hGlobal); // Déverrouiller le handle global
   ReleaseStgMedium(LMediumDonnees); // Libérer les ressources du medium de stockage
 end;
end;

function TMemoGlisserDeposer.QueryInterface(const IID: TGUID; out P_Obj): HResult;
begin
 // Méthode standard pour l'implémentation de QueryInterface pour les interfaces COM
 if GetInterface(IID, P_Obj) then
   Result := S_OK
 else
   Result := E_NOINTERFACE;
end;

function TMemoGlisserDeposer._AddRef: Integer;
begin
 // Incrémente le compteur de références et retourne la nouvelle valeur
 Result := InterlockedIncrement(FCompteurReferences);
end;

function TMemoGlisserDeposer._Release: Integer;
begin
 // Décrémente le compteur de références et retourne la nouvelle valeur
 Result := InterlockedDecrement(FCompteurReferences);
 if Result = 0 then
   // Si le compteur atteint zéro, l'objet est libéré
   Destroy;
end;

L'activation ou la désactivation du support de glisser-déposer pour ce composant se fait via sa propriété SupporteDepot.

Solution générique pour les contrôles d'édition de texte

L'approche précédente est spécifique à un TMemo personnalisé. Cependant, il est souvent utile d'activer le glisser-déposer de texte sur n'importe quel contrôle Windows capable d'afficher ou d'éditer du texte, tel qu'un TEdit, un TRichEdit ou un TMemo standard. Pour cela, nous pouvons créer une classe utilitaire indépendante qui implémente IDropTarget et s'enregistre auprès du handle de fenêtre (THandle) du contrôle cible.


type
 TGestionnaireGlisserTexte = class(TObject, IUnknown, IDropTarget)
 private
   FHandleCible: THandle; // Le handle du contrôle Windows qui recevra le texte
   FResultatValidation: HResult; // L'état de la validation du format de données
   FFormatTexteDesire: TFormatEtc; // Le format de données de texte attendu
   FCompteurRefExterne: Integer; // Compteur de références COM
 protected
   // Méthodes de l'interface IUnknown
   function QueryInterface(const IID: TGUID; out P_Obj: Pointer): HResult; stdcall;
   function _AddRef: Integer; stdcall;
   function _Release: Integer; stdcall;

   // Méthodes de l'interface IDropTarget
   function DragEnter(const P_DataObject: IDataObject; P_CleEtat: Longint;
     P_Position: TPoint; var P_EffetDepot: Longint): HResult; stdcall;
   function DragOver(P_CleEtat: Longint; P_Position: TPoint;
     var P_EffetDepot: Longint): HResult; stdcall;
   function DragLeave: HResult; stdcall;
   function Drop(const P_DataObject: IDataObject; P_CleEtat: Longint; P_Position: TPoint;
     var P_EffetDepot: Longint): HResult; stdcall;
 public
   constructor Create(P_HandleCible: THandle);
   destructor Destroy; override;
 end;

{ TGestionnaireGlisserTexte implémentation }

constructor TGestionnaireGlisserTexte.Create(P_HandleCible: THandle);
begin
 inherited Create;
 FCompteurRefExterne := 0; // Initialiser le compteur de références
 FHandleCible := P_HandleCible;
 // Enregistrer cette instance comme cible de dépôt pour le handle spécifié
 RegisterDragDrop(FHandleCible, Self);
end;

destructor TGestionnaireGlisserTexte.Destroy;
begin
 // Révoquer l'enregistrement du glisser-déposer lors de la destruction de l'objet
 RevokeDragDrop(FHandleCible);
 inherited;
end;

function TGestionnaireGlisserTexte.DragEnter(const P_DataObject: IDataObject;
 P_CleEtat: Integer; P_Position: TPoint; var P_EffetDepot: Integer): HResult;
begin
 Result := E_FAIL;
 FResultatValidation := E_FAIL;

 if not Assigned(P_DataObject) then
   Exit;

 // Définir le format de texte désiré pour le transfert
 with FFormatTexteDesire do
 begin
{$IFDEF UNICODE}
   cfFormat := CF_UNICODETEXT;
{$ELSE}
   cfFormat := CF_TEXT;
{$ENDIF}
   ptd := nil;
   dwAspect := DVASPECT_CONTENT;
   lindex := -1;
   tymed := TYMED_HGLOBAL;
 end;

 // Vérifier la capacité de l'objet de données à fournir le format texte
 FResultatValidation := P_DataObject.QueryGetData(FFormatTexteDesire);
 Result := FResultatValidation;

 if Succeeded(Result) then
   P_EffetDepot := DROPEFFECT_COPY
 else
   P_EffetDepot := DROPEFFECT_NONE;
end;

function TGestionnaireGlisserTexte.DragLeave: HResult;
begin
 FResultatValidation := E_FAIL; // Réinitialiser l'état
 Result := S_OK;
end;

function TGestionnaireGlisserTexte.DragOver(P_CleEtat: Integer; P_Position: TPoint;
 var P_EffetDepot: Integer): HResult;
begin
 // L'effet de dépôt est généralement déjà établi dans DragEnter, peu de logique ici
 Result := S_OK;
end;

function TGestionnaireGlisserTexte.Drop(const P_DataObject: IDataObject; P_CleEtat: Integer;
 P_Position: TPoint; var P_EffetDepot: Integer): HResult;
var
 LMedium: TStgMedium;
 LHandleGlobal: HGLOBAL;
begin
 Result := E_FAIL;

 if Failed(FResultatValidation) then
   Exit; // Aucun format valide précédemment identifié

 // Tenter d'obtenir les données dans le format texte
 Result := P_DataObject.GetData(FFormatTexteDesire, LMedium);
 if Failed(Result) then
 begin
   ReleaseStgMedium(LMedium);
   Exit;
 end;

 // Verrouiller le handle global pour un accès mémoire
 LHandleGlobal := HGLOBAL(GlobalLock(LMedium.hGlobal));
 if LHandleGlobal = 0 then
 begin
   ReleaseStgMedium(LMedium);
   Exit;
 end;

 try
   // Envoyer le message WM_SETTEXT au contrôle cible pour y coller le texte
   SendMessage(FHandleCible, WM_SETTEXT, 0, LParam(LHandleGlobal));
   P_EffetDepot := DROPEFFECT_COPY;
 finally
   GlobalUnlock(LMedium.hGlobal); // Déverrouiller la mémoire
   ReleaseStgMedium(LMedium); // Libérer les ressources du medium de stockage
 end;
end;

function TGestionnaireGlisserTexte.QueryInterface(const IID: TGUID; out P_Obj): HResult;
begin
 // Implémentation standard de QueryInterface
 if GetInterface(IID, P_Obj) then
   Result := S_OK
 else
   Result := E_NOINTERFACE;
end;

function TGestionnaireGlisserTexte._AddRef: Integer;
begin
 Result := InterlockedIncrement(FCompteurRefExterne);
end;

function TGestionnaireGlisserTexte._Release: Integer;
begin
 Result := InterlockedDecrement(FCompteurRefExterne);
 if Result = 0 then
   Destroy; // L'objet est libéré lorsque plus aucune référence ne le maintient
end;

L'utilisation de cette classe est simple : il suffit de créer une instance en lui passant le handle du contrôle désiré.


var
 LGestionnaire: TGestionnaireGlisserTexte;
begin
 // Exemple d'activation du glisser-déposer de texte pour un Memo nommé Memo1
 LGestionnaire := TGestionnaireGlisserTexte.Create(Memo1.Handle);
 // Le gestionnaire restera actif tant que son compteur de références est > 0 ou qu'il est libéré manuellement.
 // Pensez à gérer la durée de vie de LGestionnaire, par exemple en l'associant à la forme qui possède Memo1.
end;

Cette approche permet de doter n'importe quel contrôle Delphi doté d'un handle de fenêtre et capable de recevoir WM_SETTEXT de la capacité d'accepter du texte glissé, sans nécessiter de modification de sa classe d'oriigne.

Étiquettes: Delphi Glisser-Déposer IDropTarget WM_DROPFILES COM

Publié le 1 juin à 22h05

L'Atelier Monstre

Intégration du Glisser-Déposer de Texte et de Fichiers dans un Contrôle Éditable Delphi

Implémentation personnalisée pour un composant TMemo

Solution générique pour les contrôles d'édition de texte

Étiquettes Populaires