type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
ListBox1: TListBox;
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure StringGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure StringGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
private
{ Private declarations }
XMouseCord: Integer;
StartDrag: Boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := Source is TStringGrid;
end;
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
i: integer;
ColumVal, CurrentCol: Integer;
begin
if Source is TStringGrid then
begin
//Вычисляем колонку
ColumVal := 0;
CurrentCol := 0;
for i := 0 to TStringGrid(Source).ColCount - 1 do
begin
ColumVal := ColumVal + TStringGrid(Source).ColWidths[i];
if XMouseCord <= ColumVal then
begin
CurrentCol := i;
break;
end;
end;
//Убеждаемся, что это не первая колонка, которая не содержит данных
if CurrentCol <> 0 then
begin
for i := 1 to TStringGrid(Source).RowCount - 1 do
begin
ListBox1.items.Add(TStringGrid(Source).Cells[CurrentCol, i]);
end;
end;
StartDrag := True;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//Для демонстрационных целей
with StringGrid1 do
begin
Cells[1, 1] := 'T1';
Cells[1, 2] := 'T2';
Cells[1, 3] := 'T3';
Cells[1, 4] := 'T4';
Cells[2, 1] := 'T5';
Cells[2, 2] := 'T6';
Cells[2, 3] := 'T7';
Cells[2, 4] := 'T8';
Cells[3, 1] := 'T9';
Cells[3, 2] := 'T10';
Cells[3, 3] := 'T11';
Cells[3, 4] := 'T12';
Cells[4, 1] := 'T13';
Cells[4, 2] := 'T14';
Cells[4, 3] := 'T15';
Cells[4, 4] := 'T16';
end;
StartDrag := True;
end;
procedure TForm1.StringGrid1DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
//Сохраняем колонку, когда начинается перетаскивание.
if StartDrag then
begin
XMouseCord := X;
StartDrag := False;
end;
end;
procedure TForm1.StringGrid1DragDrop(Sender, Source: TObject; X,
Y: Integer);
begin
//В данном случае помещаем е¸ на грид
StartDrag := True;
end;
|