скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

Drag and Drop для двух компонентов TOutline



Автор: Lloyd Linklater (Sysop) (Delphi Technical Support)


unit Unit1;

interface

uses

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids, Outline;

type

  TForm1 = class(TForm)
    Outline1: TOutline;
    Outline2: TOutline;
    procedure OutlineDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure OutlineMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OutlineDragOver(Sender, Source: TObject; X, Y: Integer;

      State: TDragState; var Accept: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

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

  with Sender as TOutline do
  begin
    AddChild(GetItem(x, y),
      TOutline(Source).Items[TOutline(Source).SelectedItem].Text);
  end;

end;

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

  Shift: TShiftState; X, Y: Integer);
begin

  if Button = mbLeft then
    with Sender as TOutline do
    begin
      if GetItem(x, y) >= 0 then
        BeginDrag(False);
    end;
end;

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

  State: TDragState; var Accept: Boolean);
begin

  if (Source is TOutline) and (TOutline(Source).GetItem(x, y) <>
    TOutline(Source).SelectedItem) then

    Accept := True
  else
    Accept := False;

end;

end.







Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook