Drag & Drop

Pour afficher une image lorsque l'on fait un drag and drop on peut utiliser cette méthode.

Cette astuce proviens directement des exemples dans LAZARUS, dans exemples/dragimagelist

  { TTileDragObject }
interface
...
  TTileDragObject = class(TDragControlObjectEx)
  private
    FDragImages: TDragImageList;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create(AControl: TControl); override;
    destructor Destroy; override;
  end;
  ...
 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 := C_SHOW_DRAG_IMAGE;
  vBitmap     := Graphics.TBitMap.Create;
  try
    vBitmap.Width  := AControl.Width;
    vBitmap.Height := AControl.Height;
    if AControl is TWinControl then TWinControl(AControl).PaintTo(vBitmap.Canvas, 0, 0);
    FDragImages.Width  := vBitmap.Width;
    FDragImages.Height := vBitmap.Height;
    FDragImages.add(vBitmap, nil);
    FDragImages.DragHotspot := Classes.Point(vBitmap.Width div 2, vBitmap.Height div 2);
  finally
    vBitmap.Free;
  end;
end;
 
destructor TTileDragObject.Destroy;
begin
  FDragImages.Free;
  inherited Destroy;
end;

Le Control qui doit être dessiné doit implémenter la méthode PaintTo :

procedure TTICTileControl.Paint;
var
  ARect: TRect;
begin
  ARect := GetClientRect;
  Canvas.FillRect(ARect);
end;
 
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;               

Dans le OnStartDrag on doit créer et remplir le TDragObject

procedure TTICTileControl.DoStartDrag(var DragObject: TDragObject);
var
  vDO: TTileDragObject;
begin
  vDO         := TTileDragObject.Create(Self);
  vDO.Control := self;
  DragObject  := vDO;
  ...
end;