روشی ساده برای Drag Drop کردن

[idehrayan]

سلام
یه روش ساده برای درگ کردن اشیا برای دوستانی که دنبال این قضیه هستن:
ابتدا عنصری که قراره درگ بشه خصوصیت dragmode=dmAutomatic بعد هم اگه اشیا روی فرم قرار دارن کدهای زیر رو در خصوصیت

DragDrop وDragover

فرم قرار میدم

توجه: اگه اشیا روی مثلا تصویر قرار دارن باید کدها زیر رو توی

خصوصیت

DragDrop وDragover

تصویر قرار بدیم

procedure Tform1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);begin

tform(Source).Left:=x;

tform(Source).Top:=y;

end;





procedure Tform1.FormDragOver(Sender, Source: TObject; X, Y: Integer;

  State: TDragState; var Accept: Boolean);

begin

 Accept:=true;

end;

یه روش اسونتر و با عملکرد بهتر کد زیر هستش که البته بر روی همه عناصر عمل نمیکنه

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

begin

  ReleaseCapture;

  SendMessage(Button1.Handle , $A1, 2, 0);

end;

اینم یک روشی که دوست عزیزم دلفی پیشنهاد داده

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  Dummy:TPanel;

begin

  with TLabel(Sender) do begin

    Dummy:=TPanel.Create(Owner);

    Dummy.Parent:=Parent;

    Dummy.BevelOuter:=bvNone;

    Dummy.Alignment:=Alignment;

    Dummy.Caption:=Caption;

    Dummy.SetBounds(Left, Top, Width, Height);

    Parent.Update;

  end;

  ReleaseCapture;

  Dummy.Perform(WM_SysCommand,$F012,0);

  with Dummy do Label1.SetBounds(Left, Top, Width, Height);

  Dummy.Free;

end;

[Mask]

علت اینکه روی همه عناصر کار نمیکنه اینه که ، یکسری از اشیایی که ما در حال استفاده هستیم از TWinControl مشتق شده اند که دارای هندل هستند،مانند دکمه. اما یکسری هم از TControl و یا TComponent مشتق شدند که هندلی ندارند(البته نه اینکه نشه باهاشون کارکرد. منظور اینه که به راحتی بدست اوردن هندل گروه اول نیستند).البته برای حل این مشکل از یک روش دیگه استفاده کردم ، که همه گروهها رو در بر میگیره.در درجه اول باید نوع روش رو تغییر داد.

[دلفــي]

اينم روي خيلي از كنترلها جواب ميده :

procedure TForm1.BitBtn1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  ReleaseCapture;

  BitBtn1.Perform(WM_SysCommand,$F012,0);

end;

[idehrayan]

اينم روي خيلي از كنترلها جواب ميده :

procedure TForm1.BitBtn1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  ReleaseCapture;

  BitBtn1.Perform(WM_SysCommand,$F012,0);

end;

متاسفانه این روش روی لیبل جواب نمیده به نظر میاد روشی قبلی شما کد زیر (البته با یه کچولو اصلاح) از همه روش ها بهتر باشه

 with TLabel(Sender) do

  begin

    Dummy:=TPanel.Create(Owner);

    Dummy.Parent:=Parent;

    Dummy.BevelOuter:=bvNone;

    Dummy.Alignment:=Alignment;

    Dummy.font:=font;

    Dummy.Caption:=Caption;

    Dummy.SetBounds(Left, Top, Width, Height);

    Parent.Update;

  end;

  ReleaseCapture;

  Dummy.Perform(WM_SysCommand,$F012,0);

  with Dummy do

   Lbl23.SetBounds(Left, Top, Width, Height);

  Dummy.Free;