Drag & Drop

Pour afficher une image lors d'un drag and drop dans Lazarus, vous pouvez utiliser la méthode décrite ci-dessous. Cette méthode est inspirée des exemples fournis avec Lazarus, situés dans le répertoire `exemples/dragimagelist`.

La première étape consiste à créer une classe dérivée de `TDragControlObjectEx` qui encapsulera la logique pour afficher l'image lors du drag and drop.

Déclaration de la classe :

{ TTileDragObject }
 
interface
 
uses
  Classes, Controls, DragDrop, Graphics, ImgList, Windows;
 
type
  TTileDragObject = class(TDragControlObjectEx)
  private
    FDragImages: TDragImageList;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create(AControl: TControl); override;
    destructor Destroy; override;
  end;

Proposition d'implémentation de la classe :

implementation
 
{ TTileDragObject }
 
function TTileDragObject.GetDragImages: TDragImageList;
begin
  Result := FDragImages;
end;
 
constructor TTileDragObject.Create(AControl: TControl);
var
  vBitmap: Graphics.TBitmap;
begin
  inherited Create(AControl);
  FDragImages := TDragImageList.Create(AControl);
  AlwaysShowDragImages := True;  // Remplacez par C_SHOW_DRAG_IMAGE si nécessaire
  vBitmap := Graphics.TBitmap.Create;
  try
    vBitmap.Width := AControl.Width;
    vBitmap.Height := AControl.Height;
    if (AControl is TWinControl) and (csReplicatable in AControl.ControlStyle) then //csReplicatable signifie que la methode PaintTo est implementée
      TWinControl(AControl).PaintTo(vBitmap.Canvas, 0, 0);
    FDragImages.Width := vBitmap.Width;
    FDragImages.Height := vBitmap.Height;
    FDragImages.Add(vBitmap, nil);
    FDragImages.DragHotspot := Mouse.CursorPos - AControl.ClientOrigin; // Positionne le DragHotSpot a l'endroit ou a été saisie le Control 
  finally
    vBitmap.Free;
  end;
end;
 
destructor TTileDragObject.Destroy;
begin
  FDragImages.Free;
  inherited Destroy;
end;

Le contrôle à partir duquel l'image sera dessinée doit implémenter la méthode PaintTo.

Si la méthode PaintTo fonctionne pour un Control, le Control doit avoir le membre [csReplicatable] dans son ControleStyle, voir csreplicatable

procedure TTICTileControl.Paint;
var
  ARect: TRect;
begin
  ARect := GetClientRect;
  Canvas.FillRect(ARect);
  // Dessinez ici le contenu de votre contrôle
end;
 
{ Si la methode PaintTo est implementée, il est bon de definir ControleStyle+[csReplicatable] }
procedure TTICTileControl.PaintTo(DC: HDC; X, Y: Integer);
var
  DCChanged: Boolean;
begin
  DCChanged := (not Canvas.HandleAllocated) or (Canvas.Handle <> DC);
  if DCChanged then
    Canvas.Handle := DC;
  try
    Paint;
  finally
    if DCChanged then
      Canvas.Handle := 0;
  end;
end;

Lorsque le drag and drop commence, vous devez créer et initialiser votre TDragObject.

procedure TTICTileControl.DoStartDrag(var DragObject: TDragObject);
var
  vDO: TTileDragObject;
begin
  vDO := TTileDragObject.Create(Self);
  vDO.Control := Self;
  DragObject := vDO;
  // Ajoutez ici tout autre initialisation nécessaire
end;

En utilisant cette approche, vous créez un objet de type TDragObject qui contient un TDragImageList pour gérer l'affichage de l'image lors du drag and drop. L'image est dessinée à partir du contrôle source grâce à la méthode PaintTo. Cette méthode permet de dessiner le contrôle dans un bitmap, qui est ensuite utilisé pour afficher l'image lors du drag.