Delphi 1

TOutLine drag & drop

Один из наших сотрудников разработал механизм "drag and drop" (перетащи и брось) для двух компонентов TOutline. Вот дословно его произведение:

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.

Я надеюсь это поможет.

Lloyd Linklater <Sysop>
Delphi Technical Support [000594]