PDA

View Full Version : سوال: چطور میشه یک TImage رو با درگ جابجا کرد؟



mbshareat
چهارشنبه 27 مهر 1401, 21:50 عصر
سلام دوستان
من دارم یه برنامه گرافیکی می نویسم که قار نبود اینقدر پیچیده اش کنم ولی به گرافیک علاقه دارم.
حتما می دونید که در برنامه هایی مثل Paint,PhotoShop میشه تصویر رو از حافظه در فایل تصویر الصاق و بعد با ماوس جابجا کرد.
قبلا در سایت کد جابجایی اشاء با درگ دیده بودم اما نمی دونم کجا بود و آیا به درد TImage میخوره یا نه؟
آیا راه ساده ای هست که یک TImage رو با ماوس درگ گنم و جابجا کنم؟ کارکرد BeginDrag رو هم بلد نیستم.

دلفــي
چهارشنبه 04 آبان 1401, 10:30 صبح
سلام دوستان
من دارم یه برنامه گرافیکی می نویسم که قار نبود اینقدر پیچیده اش کنم ولی به گرافیک علاقه دارم.
حتما می دونید که در برنامه هایی مثل Paint,PhotoShop میشه تصویر رو از حافظه در فایل تصویر الصاق و بعد با ماوس جابجا کرد.
قبلا در سایت کد جابجایی اشاء با درگ دیده بودم اما نمی دونم کجا بود و آیا به درد TImage میخوره یا نه؟
آیا راه ساده ای هست که یک TImage رو با ماوس درگ گنم و جابجا کنم؟ کارکرد BeginDrag رو هم بلد نیستم.

می تونید از فایل ضمیمه شده کمک بگیرید

mbshareat
چهارشنبه 04 آبان 1401, 20:49 عصر
سلام علیکم
ممنونم. اما در مورد Image جواب نداد.خصوصیت DragMode:=dmAutomatic کردم و از کد زیر استفاده کردم اما کار نکرد. فکر کنم بهتره میانبر نرم. من گفتم شاید بشه ناحیه انتخاب شده یا الصاق شده از حافظه رو ساده تر جابجا کنم.:لبخند:
procedure TForm1.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
var shape:TImage;
begin
if source is TMyDragobject then
with source as TMyDragObject do
begin
shape:=TImage(control);
if (sender=shape)then {dropping on ourselves, move the shape}
begin
shape.left:=shape.left+x-hotx;
shape.top:=shape.top+y-hoty;
{snap if dropping on panel and option is checked}
end;
end;
End;
procedure TForm1.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
shape:TImage;
begin
if source is TMyDragObject then
with source as TMyDragObject do
begin
shape:=TImage(control); {shape is the object being dragged, sender is the object
being dragged over - check if they are the sme}
if (sender<>shape) then accept:=false //else
{even if dragging over ourselves, don't drop on another shape}
//accept:=not overlaps(shape.parent,shape,shape.left+x,shape.top +y);
end;
end;
procedure TForm1.Image1StartDrag(Sender: TObject;
var DragObject: TDragObject);
var
b:TBitmap;
index:integer;
p:TPoint;
begin
if sender is TShape then
with sender as TShape do
begin
dragImageList.clear;
dragimagelist.height:=height;
dragimagelist.width:=width;
b:=tBitmap.create;
b.width:=width;
b.height:=height;
with b.canvas do
begin
brush.color:=tshape(sender).brush.color;
brush.style:=bssolid;
case shape of
stRectangle: rectangle(0,0,width,height);
stRoundrect: roundrect(0,0,width,height, width div 4, height div 4);
end;
end;
if DragImageList.Add(b,nil)<0 then showmessage('Dragmage add failed');
p:=screentoclient(mouse.cursorpos);
hotx:=p.x; {keep track of cursor location relative to top left corner }
hoty:=p.y; {of the shape being dragged}

dragimagelist.setdragimage(0,hotx,hoty); {set the drag image}
DragObject := TMyDragObject.Create(TImage(Sender)); {Create the drag object}
{remove from PartsList list is there}
//index:=PartsList.indexof(TShape(sender));
//if index>=0 then PartsList.extract(Tshape(sender));
end;
end;