Советы по Delphi
         

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]



Содержание раздела