Вот рабочий пример. Расположите на форме панель побольше, скопируйте и измените приведенный код так, чтобы изображение загружалось из ВАШЕГО каталога Delphi.

 

Code:

procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

with Source as TImage do

begin

   Left := X;

   Top := Y;

end;

end;

 

procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept := Source is TImage;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

with TImage.Create(Self) do

begin

   Parent := Panel1;

   AutoSize := True;

   Picture.LoadFromFile('D:\DELPHI\IMAGES\CHIP.BMP');

   DragMode := dmAutomatic;

   OnDragOver := Panel1DragOver;

   OnDragDrop := Panel1DragDrop;

end;

end;

 

https://delphiworld.narod.ru/

DelphiWorld 6.0

 

 

Вам нужно перехватывать в TOutline сообщение wm_DropFiles. Для этого необходимо создать его потомка. Также, вы должны убедиться в том, что дескриптор TOutline Handle хотя бы раз передавался в качестве параметра функции DragAcceptFiles. Для определения положения мыши в момент перетаскивания используется DragQueryPoint. Если вы прочтете разделы в WINAPI.HLP по DragAcceptFiles, wm_DropFiles, DragQueryFile, DragQueryPoint и DragFinish, то вы поймете, как все это работает.

 

 

 

Code:

{

This example shows how to drag&drop within a TListBox.

The Demo Program also shows how to implement an autoscroll-feature.

}

 

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;

  State: TDragState; var Accept: Boolean);

begin

  Accept := Sender is TListBox;

end;

 

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

  iTemp: Integer;

  ptTemp: TPoint;

  szTemp: string;

begin

  { change the x,y coordinates into a TPoint record }

  ptTemp.x := x;

  ptTemp.y := y;

 

  { Use a while loop instead of a for loop due to items possible being removed

  from listboxes this prevents an out of bounds exception }

  iTemp := 0;

   while iTemp <= TListBox(Source).Items.Count-1 do

  begin

    { look for the selected items as these are the ones we wish to move }

    if TListBox(Source).selected[iTemp] then

    begin

      { use a with as to make code easier to read }

      with Sender as TListBox do

      begin

      { need to use a temporary variable as when the item is deleted the

       indexing will change }

        szTemp := TListBox(Source).Items[iTemp];

 

        { delete the item that is being dragged  }

        TListBox(Source).Items.Delete(iTemp);

 

      { insert the item into the correct position in the listbox that it

      was dropped on }

        Items.Insert(itemAtPos(ptTemp, True), szTemp);

      end;

    end;

    Inc(iTemp);

  end;

end;

 

 

 

Code:

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

ComCtrls;

 

type

TForm1 = class(TForm)

   TreeView1: TTreeView;

   procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);

   procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;

     State: TDragState; var Accept: Boolean);

private

   procedure MoveNode(TargetNode, SourceNode: TTreeNode);

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.MoveNode(TargetNode, SourceNode: TTreeNode);

var

NodeTmp: TTreeNode;

I: Integer;

begin

with TreeView1 do

begin

   // проверяем, является ли целевой элемент предком перетаскиваемого

   NodeTmp := TargetNode.Parent;

   while Assigned(NodeTmp) do

     if NodeTmp = SourceNode then

       Abort

     else

       NodeTmp := NodeTmp.Parent;

 

   // копируем перетаскиваемый элемент в новосозданный

   NodeTmp := Items.AddChild(TargetNode, SourceNode.Text);

   NodeTmp.Data := SourceNode.Data;

 

   for I := 0 to SourceNode.Count - 1 do

     MoveNode(NodeTmp, SourceNode.Item[I]);

 

   Selected := NodeTmp;

   TopItem := NodeTmp.getPrev;

   TargetNode.Expand(True);

end;

end;

 

procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

TargetNode, SourceNode: TTreeNode;

begin

with TreeView1 do

begin

   TargetNode := GetNodeAt(X, Y);

   SourceNode := Selected;

 

   if (TargetNode = SourceNode) or (TargetNode = nil) then

   begin

     EndDrag(False);

     Exit;

   end;

   MoveNode(TargetNode, SourceNode);

   SourceNode.Free;

end;

end;

 

procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

var

SourceNode, TargetNode, NodeTmp: TTreeNode;

begin

if Sender = TreeView1 then

try

   // скроллинг дерева при перетаскивании

   if Y > TreeView1.Height - 10 then

   begin

     TreeView1.TopItem := TreeView1.TopItem.getNext;

     Sleep(100); // пауза

   end else

     if Y < 10 then

     begin

       TreeView1.TopItem := TreeView1.TopItem.getPrev;

       Sleep(100); // пауза

     end;

 

   TargetNode := TreeView1.GetNodeAt(X, Y);

   SourceNode := TreeView1.Selected;

 

   if (TargetNode = nil) or (TargetNode = SourceNode) then Abort;

 

   Accept := True;

   // проверяем, является ли целевой элемент предком перетаскиваемого

   NodeTmp := TargetNode.Parent;

   while Assigned(NodeTmp) do

     if NodeTmp = SourceNode then

       Abort

     else

       NodeTmp := NodeTmp.Parent;

except

   Accept := False;

end;

end;

 

end.

Автор: Smike

Взято из https://forum.sources.ru

Code:

{

This example shows how to fill out fields in your webbrowser by

dragging the content of Label1 to a field of your webbrowser}

 

 

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  label1.DragMode := dmAutomatic;

end;

 

 

procedure TForm1.WebBrowserDragOver(Sender, Source: TObject; X,

  Y: Integer; State: TDragState; var Accept: Boolean);

var

  item: Variant;

begin

  //check if document is interactive

if (Webbrowser.ReadyState and READYSTATE_INTERACTIVE) = 3 then

  begin

    item := WebBrowser.OleObject.Document.elementFromPoint(x, y);

    if Source is TLabel then

      Accept := True;

    Accept := (item.tagname = 'INPUT') and ((item.type = 'text') or

      (item.type = 'password')) or (item.tagname = 'TEXTAREA');

  end;

end;

 

procedure TForm1.WebBrowserDragDrop(Sender, Source: TObject; X,

  Y: Integer);

var

  item: Variant;

begin

  //check if document is interactive

if (Webbrowser.ReadyState and READYSTATE_INTERACTIVE) = 3 then

  begin

    item       := WebBrowser.OleObject.Document.elementFromPoint(x, y);

    item.Value := label1.Caption;

  end;

end;

 

 

Drag and Drop для TListBox на примере двойного списка

 

Автор: Александр Малыгин

Специально для Королевства Delphi

 

Типичная задача перетаскивания мышью объектов из одного контрола в другой просто решается обработкой событий OnDragOver и OnDragDrop, при установленных свойствах DragMode := dmAutomatic и DragKind := dkDrag у всех участвующих компонентов.

 

Первый обработчик предназначен для принятия решения - допускается ли сбросить объект в контрол, над которым находится мышь (параметр Sender), и выставить соответствующий курсор. Для этого передается параметр Source:TObject, представляющий собой тот компонент, с которого начали перетаскивание (источник), координаты курсора X,Y:integer, состояние процесса перетаскивания State:TDragState, и результат, который надо вернуть var Accept:boolean.

 

Данный способ позволяет не погружаясь глубоко в создание компонент осуществить операцию "drag and drop" выделенного текста.

 

Создайте новый компонент (TMyMemo), наследовав его от TMemo. И объявите его следующим образом:

 

Code:

var

  Form1: TForm1;

  richcopy: string;

  transfering: boolean;

implementation

 

{$R *.DFM\}

 

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

  Shift: TShiftState; X, Y: Integer);

begin

if length(richedit1.seltext)>0 then begin

  richcopy:=richedit1.seltext;

  transfering:=true;

end; //seltext

end;

 

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

  Y: Integer);

begin

if transfering then begin

  transfering:=false;

  listbox1.items.add(richcopy);

end; //transfering

end;

 

Данный способ позволяет не погружаясь глубоко в создание компонент осуществить операцию "drag and drop" выделенного текста.

 

Создайте новый компонент (TMyMemo), наследовав его от TMemo. И объявите его следующим образом:

 

Code:

type

TMyMemo = class(TMemo)

private

   FLastSelStart : Integer;

   FLastSelLength : Integer;

   procedure WMLButtonDown(var message: TWMLButtonDown); message WM_LBUTTONDOWN;

published

   property LastSelStart : Integer read FLastSelStart write FLastSelStart;

   property LastSelLength : Integer read FLastSelLength write FLastSelLength;

end;

 

Code:

{ ListView1.DragMode := dmAutomatic }

 

procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

DragItem, DropItem, CurrentItem, NextItem: TListItem;

begin

if Sender = Source then

   with TListView(Sender) do

   begin

     DropItem    := GetItemAt(X, Y);

     CurrentItem := Selected;

     while CurrentItem <> nil do

     begin

       NextItem := GetNextItem(CurrentItem, SdAll, [IsSelected]);

       if DropItem = nil then DragItem := Items.Add

       else

         DragItem := Items.Insert(DropItem.Index);

       DragItem.Assign(CurrentItem);

       CurrentItem.Free;

       CurrentItem := NextItem;

     end;

   end;

end;

 

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState;

var Accept: Boolean);

begin

Accept := Sender = ListView1;

end;

 

 

Возьмите форму, бросьте на нее панель, на onMouseDown панели прицепите код:

 

Code:

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

Shift: TShiftState; X, Y: Integer);

{©Drkb v.3(2007): www.drkb.ru}

begin

ReleaseCapture;

Panel1.Perform(WM_SYSCOMMAND, $F012, 0);

end;

 

Теперь в run-time панель можно таскать как в дизайне...

 

Взято с Vingrad.ru https://forum.vingrad.ru