Перетаскивание объектов

Code:

unit Udrag1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TForm1 = class(TForm)

   Memo1: TMemo;

   Label1: TLabel;

   Label2: TLabel;

   Label3: TLabel;

   ListBox1: TListBox;

   ListBox2: TListBox;

   ListBox3: TListBox;

   ListBox4: TListBox;

   Label4: TLabel;

   CheckBox1: TCheckBox;

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

     State: TDragState; var Accept: Boolean);

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

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

     State: TDragState; var Accept: Boolean);

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

   procedure ListBox3MouseDown(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

   procedure Label1EndDrag(Sender, Target: TObject; X, Y: Integer);

   procedure ListBox4MouseDown(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

private { Private declarations }

public { Public declarations }

end;

var

Form1: TForm1;

implementation{$R *.DFM}

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

State: TDragState; var Accept: Boolean);

begin

Accept := (Source is TLabel) or (Source is TListBox);

end;

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

begin

if (Source.ClassName = 'TLabel') then

   Memo1.Lines.Add((Source as TLabel).Caption)

else

   Memo1.Lines.Add((Source as TListBox).

     Items[(Source as TListBox).ItemIndex]);

;

end;

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

State: TDragState; var Accept: Boolean);

begin

if (Sender <> Source) then

   Accept := Source is TListBox

else

   Accept := False;

end;

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

begin

(Sender as TListBox).Items.Add((Source as TListBox).

   Items[(Source as TListBox).ItemIndex]);

if (Source as TListBox).Name <> 'ListBox2' then

   (Source as TListBox).Items.Delete((Source as TListBox).ItemIndex);

end;

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

Shift: TShiftState; X, Y: Integer);

begin

if (Button = mbLeft) and (ssAlt in Shift) then

   (Sender as TControl).BeginDrag(false);

end;

procedure TForm1.Label1EndDrag(Sender, Target: TObject; X, Y: Integer);

begin

if CheckBox1.Checked then

   if Target = nil then

     ShowMessage('Перенесение объекта ' + (Sender as TControl).Name +

       ' прервано')

   else

     ShowMessage((Sender as TControl).Name + ' перенесена в ' +

       (Target as TControl).Name);

end;

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

Shift: TShiftState; X, Y: Integer);

begin

if (Button = mbLeft) and (ssAlt in Shift) then

   (Sender as TListBox).BeginDrag(true);

end;

end.