چطور میشه یک TImage رو با درگ جابجا کرد؟
سلام دوستان
من دارم یه برنامه گرافیکی می نویسم که قار نبود اینقدر پیچیده اش کنم ولی به گرافیک علاقه دارم.
حتما می دونید که در برنامه هایی مثل Paint,PhotoShop میشه تصویر رو از حافظه در فایل تصویر الصاق و بعد با ماوس جابجا کرد.
قبلا در سایت کد جابجایی اشاء با درگ دیده بودم اما نمی دونم کجا بود و آیا به درد TImage میخوره یا نه؟
آیا راه ساده ای هست که یک TImage رو با ماوس درگ گنم و جابجا کنم؟ کارکرد BeginDrag رو هم بلد نیستم.
1 ضمیمه
نقل قول: چطور میشه یک TImage رو با درگ جابجا کرد؟
نقل قول:
نوشته شده توسط
mbshareat
سلام دوستان
من دارم یه برنامه گرافیکی می نویسم که قار نبود اینقدر پیچیده اش کنم ولی به گرافیک علاقه دارم.
حتما می دونید که در برنامه هایی مثل Paint,PhotoShop میشه تصویر رو از حافظه در فایل تصویر الصاق و بعد با ماوس جابجا کرد.
قبلا در سایت کد جابجایی اشاء با درگ دیده بودم اما نمی دونم کجا بود و آیا به درد TImage میخوره یا نه؟
آیا راه ساده ای هست که یک TImage رو با ماوس درگ گنم و جابجا کنم؟ کارکرد BeginDrag رو هم بلد نیستم.
می تونید از فایل ضمیمه شده کمک بگیرید
نقل قول: چطور میشه یک TImage رو با درگ جابجا کرد؟
سلام علیکم
ممنونم. اما در مورد 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;