15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту


Как перетащить целую колонку из Stringgrid в Listbox.

Компилятор: Delphi

В Object Inspector установите свойство dragmode у StringGrid в dmAutomatic.

Ниже приведён полный код:

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;