delphi – 拖放时移动图像
我在TPanel上有一个T Image,另一个(空)TPanels.我想拖
图像从第一个到第二个面板使用拖放.
我真的想看到图像从一个面板移动到
其他(半透明).
我想我应该使用TDragObject.GetDragImages,但我不知道如何构建整个魔术.
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,Y: Integer); begin if (Source is TImage) then begin TImage(Source).Parent := TPanel(Sender); TImage(Source).Align := alClient; end; end;
更新 – 我发现一个有用的文章:Implementing Professional Drag & Drop In VCL/CLX Applications
解决方法
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,Y: Integer; State: TDragState; var Accept: Boolean); procedure FormDestroy(Sender: TObject); procedure Panel1DragDrop(Sender,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,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,Y: Integer); begin if FDragObject.DragSource is TImage then TImage(FDragObject.DragSource).Parent := TPanel(Sender); end; procedure TForm3.Panel1DragOver(Sender,Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := Source is TMyDragObject; end; end.
好的代码像粥一样,都是用时间熬出来的
分类:
Delphi
· 浏览器原生「磁吸」效果!Anchor Positioning 锚点定位神器解析
· 没有源码,如何修改代码逻辑?
· 一个奇形怪状的面试题:Bean中的CHM要不要加volatile?
· [.NET]调用本地 Deepseek 模型
· 一个费力不讨好的项目,让我损失了近一半的绩效!
· 全网最简单!3分钟用满血DeepSeek R1开发一款AI智能客服,零代码轻松接入微信、公众号、小程
· .NET 10 首个预览版发布,跨平台开发与性能全面提升
· 《HelloGitHub》第 107 期
· 全程使用 AI 从 0 到 1 写了个小工具
· 从文本到图像:SSE 如何助力 AI 内容实时呈现?(Typescript篇)
2018-12-26 在临床医学里面,bid、tid、qid和q3w是什么意思啊??这些缩写的全称是怎么写呢??