Drag and Drop внутри своего приложения

Code:

FDragItem := ItematPos(X, Y, True);

if FDragItem >= 0 then

BeginDrag(false);

...

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

begin

if Source is TDirectoryListBox then

   ListBox.Items.Add(TDirectoryListBox(Source).GetItemPath(FDragItem));

end;

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;

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;

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;

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.

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;