Программы   Загрузка Партнерство   О компании Контакты  
 
                    
  Карта Сайта   
   

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 © LSD Software 2006 - 2011