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.
复制代码

 

posted on   癫狂编程  阅读(421)  评论(0编辑  收藏  举报

编辑推荐:
· 浏览器原生「磁吸」效果!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是什么意思啊??这些缩写的全称是怎么写呢??

导航

< 2025年3月 >
23 24 25 26 27 28 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31 1 2 3 4 5
好的代码像粥一样,都是用时间熬出来的
点击右上角即可分享
微信分享提示