Drag Drop

← →
IgoX (2002-06-19 21:51) [0]

Привет каждому.
Есть ListView если я беру и тяну одну запись то она тянеться со всеми столбцами. Как сделать чтобы тянулся листик- как будто я тяну больше одной записи.
Спасибо

← →
MBo (2002-06-20 06:53) [1]

Некоторые идеи
http://delphi.mastak.ru/articles/dragndrop/index.html

← →
IgoX (2002-06-20 20:16) [2]

Спасибо
прочитал но то что мне нужно не нашел.
Как можно навесить свою картинку при DragDrop?

← →
MBo (2002-06-20 20:17) [3]

DragImageList

← →
MBo (2002-06-21 08:33) [4]

LV1 - ListView c 2 колонками

type
TLVDragObject = class(TDragControlObject)
private
FDragImages: TDragImageList;
protected
function GetDragImages: TDragImageList; override;
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
public
Str: String;
destructor Destroy; override;
end;

TForm1 = class(TForm)
LV1: TListView;
Memo1: TMemo;
procedure Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure FormCreate(Sender: TObject);
procedure LV1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure LV1StartDrag(Sender: TObject; var DragObject: TDragObject);
procedure Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
ADragObject: TLVDragObject;

implementation

{$R *.DFM}

procedure TForm1.Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept:=Source=ADragObject;
end;

destructor TLVDragObject.Destroy;
begin
FDragImages.Free;
inherited;
end;

function TLVDragObject.GetDragCursor(Accepted: Boolean; X,
Y: Integer): TCursor;
begin
if Accepted then Result := crNone
else Result := crNo
end;

function TLVDragObject.GetDragImages: TDragImageList;
var
B: TBitmap;
s:string;
i: Integer;
begin
if not Assigned(FDragImages) then
FDragImages := TDragImageList.Create(nil);
Result := FDragImages;
Result.Clear;
s:=ADragObject.Str;
B := TBitmap.Create;
try
B.Height :=B.Canvas.TextHeight(s);
B.Width := B.Canvas.TextWidth(s);
B.Canvas.Brush.Color := clLime;
B.Canvas.FillRect(B.Canvas.ClipRect);
B.Canvas.TextOut(0, 0,s);
Result.Width := B.Width;
Result.Height := B.Height;
i:= Result.AddMasked(B, clLime);
Result.SetDragImage(i, 0, 0);
finally
B.Free;
end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.ControlStyle := Memo1.ControlStyle + [csDisplayDragImage];
end;

procedure TForm1.LV1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
LV1.BeginDrag(False);
//если устроит dmAutomatic, то этот обработчик не нужен
end;

procedure TForm1.LV1StartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
ADragObject := TLVDragObject.Create(LV1);
ADragObject.Str := LV1.Selected.Caption+" "+LV1.Selected.SubItems[0];
DragObject := ADragObject;
end;

procedure TForm1.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
Memo1.Lines.Text:=ADragObject.Str;
end;

← →
IgoX (2002-06-21 21:27) [5]

Спасибо

Drag Drop Найти похожие ветки