delphi drag-and-drop delphi-7

delphi - Mover imágenes mientras arrastra y suelta



drag-and-drop delphi-7 (1)

unit Unit3; interface // 2012 Thomas Wassermann - demo uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TMyDragObject = class(TDragControlObject) private FImageList:TImageList; FDragSource:TControl; protected function GetDragImages: TDragImageList; override; public Procedure StartDrag(G:TGraphic;p:TPoint;DragSource:TControl); Constructor Create(AControl: TControl); override; Destructor Destroy;override; Property DragSource:TControl read FDragSource; end; TForm3 = class(TForm) Panel1: TPanel; Panel2: TPanel; Image1: TImage; procedure Image1StartDrag(Sender: TObject; var DragObject: TDragObject); procedure FormCreate(Sender: TObject); procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure FormDestroy(Sender: TObject); procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); private { Private-Deklarationen } FDragObject:TMyDragObject; public { Public-Deklarationen } end; var Form3: TForm3; implementation constructor TMyDragObject.Create(AControl: TControl); begin inherited; FImageList:=TImageList.Create(nil); end; destructor TMyDragObject.Destroy; begin FImageList.Free; inherited; end; function TMyDragObject.GetDragImages: TDragImageList; begin Result := FImageList; end; {$R *.dfm} procedure TMyDragObject.StartDrag(G: TGraphic;p:TPoint;DragSource:TControl); var bmp:TBitMap; begin FDragSource := DragSource; bmp:=TBitMap.Create; try FImageList.Width := g.Width; FImageList.Height := g.Height; bmp.Width := g.Width; bmp.Height := g.Height; bmp.Canvas.Draw(0,0,g); FImageList.Add(bmp,nil); finally bmp.Free; end; FImageList.SetDragImage(0,p.x,p.y) end; procedure TForm3.FormCreate(Sender: TObject); var i:Integer; begin ControlStyle := ControlStyle + [csDisplayDragImage]; for I := 0 to ControlCount -1 do if Controls[i] is TPanel then TPanel(Controls[i]).ControlStyle := TPanel(Controls[i]).ControlStyle + [csDisplayDragImage]; ReportMemoryLeaksOnShutDown := True; end; procedure TForm3.FormDestroy(Sender: TObject); begin if Assigned(FDragObject) then FDragObject.Free; end; procedure TForm3.Image1StartDrag(Sender: TObject; var DragObject: TDragObject); var p:TPoint; begin p:=TImage(Sender).ScreenToClient(mouse.cursorpos); if Assigned(FDragObject) then FDragObject.Free; FDragObject := TMyDragObject.Create(TImage(Sender)); FDragObject.StartDrag(TImage(Sender).Picture.Graphic,p,TImage(Sender)); DragObject := FDragObject; end; procedure TForm3.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); begin if FDragObject.DragSource is TImage then TImage(FDragObject.DragSource).Parent := TPanel(Sender); end; procedure TForm3.Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := Source is TMyDragObject; end; end.

Tengo un TImage en un TPanel y en otros TPanels (vacíos). Quiero arrastrar la imagen desde el primer al segundo panel usando la función de arrastrar y soltar.

De hecho, quiero ver la imagen mientras se mueve de un panel a otro (semitransparente).

Creo que debería usar TDragObject.GetDragImages pero no puedo entender cómo construir toda la magia.

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Image1.ControlStyle := Image1.ControlStyle + [csDisplayDragImage]; // ??? TImage(Sender).BeginDrag(False); end; procedure TForm1.Image1StartDrag(Sender: TObject; var DragObject: TDragObject); begin // ??? end; procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin if (Source is TImage) then Accept := TImage(Source).Parent <> Sender; end; procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); begin if (Source is TImage) then begin TImage(Source).Parent := TPanel(Sender); TImage(Source).Align := alClient; end; end;

Actualización - Encontré un artículo útil: Implementación de Arrastrar y soltar profesional en aplicaciones VCL / CLX