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

Drag and Drop из TScrollBox

2017-08-09T19:16:24+07:00

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 - как использовать ItemAtPos для получения элемента DirListBox

2017-08-09T19:14:21+07:00

Просто сохраните результат функции ItematPos в переменной формы, и затем используйте эту переменную в обработчике ListBoxDragDrop. Пример:

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;

Drag and Drop TImage

2017-08-09T19:06:56+07:00

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

Code:

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

begin

with Source as TImage do

begin

Left := X;

Top := Y;

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;

https://delphiworld.narod.ru/

DelphiWorld 6.0

Drag and Drop в TOutline

2017-08-09T19:21:52+07:00

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

Подробнее...

Drag and Drop в TTreeView

2017-08-09T19:04:08+07:00

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;

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;

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.

Автор: Smike

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

Подробнее...

Drag and Drop для TListBox

2017-08-09T19:13:06+07:00

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 из RichEdit

2017-08-09T19:15:14+07:00

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 несколько элементов в TListView

2017-08-09T19:17:20+07:00

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;

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

State: TDragState;

var Accept: Boolean);

begin

Accept := Sender = ListView1;

end;

Drag and Drop со списками

2017-08-09T19:18:10+07:00

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;

Inc(iTemp);

end;

Заполнение полей формы в TWebBrowser методом Drag-and-Drop

2017-08-09T19:23:31+07:00

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;

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;

Как перетаскивать (Drag and Drop) выделенный текст между компонентами Memo?

2017-08-09T18:57:17+07:00

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

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

Подробнее...

Как перетаскивать выделенный текст между компонентами Memo

2017-08-09T19:25:07+07:00

Создайте новый компонент (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;

Подробнее...

Как перетаскивать компоненты в Run-Time?

2017-08-09T18:59:46+07:00

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

Code:

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

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

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

end;

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

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

Как перетащить целую колонку из StringGrid в ListBox

2017-08-09T19:26:04+07:00

В Object Inspector установите свойство dragmode у StringGrid в dmAutomatic.

Ниже приведён полный код:

Подробнее...

Перестроить вкладки TPageControl с помощью Drag and Drop

2017-08-09T18:54:17+07:00

Code:

// In the PageControl's OnMouseDown event handler:

procedure TForm1.PageControl1MouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

PageControl1.BeginDrag(False);

end;

// In the PageControl's OnDragDrop event handler:

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

const

TCM_GETITEMRECT = $130A;

var

i: Integer;

r: TRect;

begin

if not (Sender is TPageControl) then Exit;

with PageControl1 do

begin

for i := 0 to PageCount - 1 do

begin

Perform(TCM_GETITEMRECT, i, lParam(@r));

if PtInRect(r, Point(X, Y)) then

begin

if i <> ActivePage.PageIndex then

ActivePage.PageIndex := i;

Exit;

end;

// In the PageControl's OnDragOver event handler:

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

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

begin

if Sender is TPageControl then

Accept := True;

end;

Взято с https://delphiworld.narod.ru

Пример Drag and Drop между двумя DBGRID

2017-08-09T19:27:11+07:00

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

Запустите Delphi 3 (с незначительными изменениями данный код может работать и в Delphi 1-2).

Активизируйте File|New|Unit. Скопируйте приведенный ниже модуль MyDBGrid во вновь созданный модуль. Сделайте File|Save As. Сохраните модуль как MyDBGrid.pas.

Выберите пункт меню Component|Install Component. Переключитесь на страницу Info New Package. Поместите MyDBGrid.pas в поле редактирования "Unit file name" (имя файла модуля). Назовите модуль MyPackage.dpk. Ответьте Yes на вопрос Delphi 3 о необходимости сборки и установки пакета. Нажмите OK на сообщение Delphi 3 о необходимости включения VCL30.DPL. После этого пакет будет собран и установлен. Теперь компонент TMyDBGrid будет отображен в Палитре Компонентов в группе "Samples". Закройте редактор пакетов и сохраните пакет.

Подробнее...

Примеры использования Drag and Drop для различных визуальных компонентов

2017-08-09T18:46:40+07:00

Перетаскивание информации с помощью мыши стало стандартом для программ, работающих в Windows. Часто это бывает удобно и позволяет добиться более быстрой работы. В данной статье я постарался показать максимальное количество примеров использования данной технологии при разработке приложений в среде Delphi. Конечно, результат может быть достигнут различными путями, продемонстрированные приемы не являются единственными и, возможно, не всегда самые оптимальные, но вполне работоспособны, и указывают направление поиска. Надеюсь, что они побудят начинающих программистов к более широкому использованию Drag'n'Drop в своих программах, тем более что пользователи, особенно неопытные, быстро привыкают к перетаскивание и часто его применяют.

Проще всего делать Drag из тех компонентов, для которых однозначно ясно, что именно перетаскивать. Для этого устанавливаем у источника DragMode = dmAutomatic, а у приемника пишем обработчики событий OnDragOver - разрешение на прием, и OnDragDrop - действия, производимые при окончании перетаскивания.

Подробнее...

Прокручивать TTreeView во время перемещения

2017-08-09T19:05:26+07:00

Code:

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

State: TDragState; var Accept: Boolean);

begin

if (y < 15) then {On the upper edge - should scroll up }

SendMessage(TreeView1.Handle, WM_VSCROLL, SB_LINEUP, 0)

else if (TreeView1.Height - y < 15) then { On the lower edge - should scroll down }

SendMessage(TreeView1.Handle, WM_VSCROLL, SB_LINEDOWN, 0);

end;