gpt4 book ai didi

delphi - 拖放时移动图像

转载 作者:行者123 更新时间:2023-12-03 14:41:44 38 4
gpt4 key购买 nike

我在一个 TPanel 上有一个 TImage,还有另一个(空)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, Source: TObject; X, 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, 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.

关于delphi - 拖放时移动图像,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/13686309/

38 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com