VPF::Сортировка чисел и строк в StringGrid

artanis

Дата 22.3.2012, 16:24 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 21.3.2012

Репутация: нет
Всего: нет

Добрый день.

Есть форма с гридом и кнопкой Open
необходимо о клику на кнопке Open – открыть диалог выбора txt файла, который затем считывается и заносится в грид. Разделитель данных внутри строк - символ табуляции. В гриде данные должны быть отсортированы (любое число в колонке выше любого не числа, числа отсортированы по возрастанию, строки в лексикографическом порядке). Сортировка производится сначала по первой колонке грида, потом по второй (если строки или числа в первой колонке совпадают) и т.д.. txt файл получен путем экспорта из Excel. Данные относящиеся к одной строке файла в гриде должны быть также в одной строке.
Никак не могу разобраться с сортировкой. Нашел пример процедуры, которая сортирует Grid по строкам одного столбца.
Вот код функции

Код


procedure SgSort(aSg : TStringGrid; const aCol : Integer);
var
  SlSort, SlRow : TStringList;
  i, j : Integer;
begin
  //Сортируемый список.
  SlSort := TStringList.Create;
 
{  Добавляем в сортируемый список пары: "строка - объект".
  В качестве строки будем записывать значения ячеек того
  столбца, по которому надо провести сортировку. Будем брать те ячейки, которые
  не принадлежат фиксированным строкам - чтобы не подвергнуть сортировке
  шапку таблицы, если она есть.
  А в качестве объекта будем присоединять копии соответствующих строк таблицы.}

  for i := aSg.FixedRows to aSg.RowCount - 1 do begin
    //Создаём контейнер для копии строки таблицы.
    SlRow := TStringList.Create;
    //Копируем строку таблицы в контейнер.
    SlRow.Assign(aSg.Rows[i]);
    //Добавляем в сортируемый список пару:
    //строка: строка из ячейки целевого столбца;
    //объект: контейнер, содержащий копию строки таблицы.
    SlSort.AddObject(aSg.Cells[aCol, i], SlRow);
  end;
 
  //Сортируем столбец.
  SlSort.Sort;
 
  //Возвращаем в таблицу строки, отсортированные по столбцу с номером aCol.
  j:=0;
  for i:=aSg.FixedRows to aSg.RowCount-1 do begin
    //Берём очередной контейнер.
    SlRow:=Pointer(SlSort.Objects[j]);
    //Записываем содержимое контейнера в строку таблицы.
    aSg.Rows[i].Assign(SlRow);
    //Уничтожаем контейнер.
    SlRow.Free;
    //Следующий индекс списка.
    Inc(j);
  end;

  //Уничтожаем сортируемый список.
  FreeAndNil(SlSort);
end;

Как можно адаптировать данную сортировку к поставленной задаче?
Вот код всей программы

Код


unit WorkForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids;

type
  TForm1 = class(TForm)
    Close_BitBtn: TBitBtn;
    Tab1: TStringGrid;
    GroupBox1: TGroupBox;
    Open_BitBtn: TBitBtn;
    Process_BitBtn: TBitBtn;
    OpenDialog1: TOpenDialog;
    ListBox1: TListBox;
    procedure Open_BitBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


{Сортировка строк таблицы по значениям ячеек в столбце с заданным индексом.
Сортировка производится в алфавитном порядке и по цифрам: 0..9
- согласно кодировочной таблице.
Фиксированные строки сортировке не подвергаются. }
procedure SgSort(aSg : TStringGrid; const aCol : Integer);
var
  SlSort, SlRow : TStringList;
  i, j : Integer;
begin
  //Сортируемый список.
  SlSort := TStringList.Create;
 
{  Добавляем в сортируемый список пары: "строка - объект".
  В качестве строки будем записывать значения ячеек того
  столбца, по которому надо провести сортировку. Будем брать те ячейки, которые
  не принадлежат фиксированным строкам - чтобы не подвергнуть сортировке
  шапку таблицы, если она есть.
  А в качестве объекта будем присоединять копии соответствующих строк таблицы.}

  for i := aSg.FixedRows to aSg.RowCount - 1 do begin
    //Создаём контейнер для копии строки таблицы.
    SlRow := TStringList.Create;
    //Копируем строку таблицы в контейнер.
    SlRow.Assign(aSg.Rows[i]);
    //Добавляем в сортируемый список пару:
    //строка: строка из ячейки целевого столбца;
    //объект: контейнер, содержащий копию строки таблицы.
    SlSort.AddObject(aSg.Cells[aCol, i], SlRow);
  end;
 
  //Сортируем столбец.
  SlSort.Sort;
 
  //Возвращаем в таблицу строки, отсортированные по столбцу с номером aCol.
  j:=0;
  for i:=aSg.FixedRows to aSg.RowCount-1 do begin
    //Берём очередной контейнер.
    SlRow:=Pointer(SlSort.Objects[j]);
    //Записываем содержимое контейнера в строку таблицы.
    aSg.Rows[i].Assign(SlRow);
    //Уничтожаем контейнер.
    SlRow.Free;
    //Следующий индекс списка.
    Inc(j);
  end;

  //Уничтожаем сортируемый список.
  FreeAndNil(SlSort);
end;

//Процедура очищает StringGrid
procedure ClearGrid(Gr: TStringGrid);
var
   i, j: integer;
begin
  with Gr do
    for i := 0 to ColCount - 1 do
    begin
      for j:= 0 to RowCount - 1 do
        Cells[i, j]:='';
      
    end;
  Gr.Row:=Gr.FixedRows;
  Gr.Col:=Gr.FixedCols;
  Gr.RowCount:=2;
  Gr.ColCount:=2;
end;


procedure TForm1.Open_BitBtnClick(Sender: TObject);
var
  L:TStringList;
  i, j:Integer;
  SBuf, s:String;
begin
  if Sender=Open_BitBtn then
   begin
     if OpenDialog1.Execute=True then
      begin
       SBuf:=OpenDialog1.FileName;
      end
     else {If input file path has not been defined}
      exit;
   end
  else
   begin
    SBuf:=ExtractFilePath(Application.ExeName);
   end;
 L:=TStringList.Create;
 L.LoadFromFile(SBuf);
 Tab1.RowCount:=L.Count+1;
 Tab1.ColCount:=2;
  for i:=0 To L.Count-1 do
    Begin
       s:= L[i];
       Tab1.Cells[0,i+1]:=Copy(s,1,Pos(#9,s)-1);
       Delete(s, 1, Pos(#9,s));
       j:=1;
       while Length(s)>0 do
       begin
         if j>Tab1.ColCount-1 then
           Tab1.ColCount:= Tab1.ColCount+1;
         if Pos(#9,s) = 0 then
         begin
           Tab1.Cells[j,i+1]:=s;
           break;
         end
         else
         begin
           Tab1.Cells[j,i+1]:=Copy(s,1,Pos(#9,s)-1);
         //  if Trim(Tab1.Cells[j,i+1]) = '' then
         //  begin
             //Если в таблице есть пустые места
          //   ShowMessage('Выберите пожалуйста другой файл');
           //   ClearGrid(Tab1);
          //   Exit;
         //  end;
           Delete(s, 1, Pos(#9,s));
           Inc(j);
         end;
       end;
    end;

  //выполняем сортировку.
  SgSort( Tab1, 0 );
  L.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//OpenDialog1.Filter:='Text files (*.txt)|*.txt|All files (*.*)|*.*';
//Выставляем фильтр для отображения только текстовых файлов
OpenDialog1.Filter:='Text files (*.txt)|*.txt|'; 

end;
end.

devitchenskiy

Дата 27.6.2012, 15:40 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 27.6.2012

Репутация: нет
Всего: нет

Я у себя в программе использую составные заголовки. в качестве разделителя в моих примерах используется ' - '. То, что до разделителя - параметры столбца, которые я заполняю по своим правилам. После разделителя - непосредственно название столбца.
В качестве параметров я указываю в т.ч. тип данных (у меня там параметры просто через запятую) - int (целые), float (дробные), check (логические, 0 - ложь, 1 - истина), txt (строковые), dat (дата и время)

отрисовку ячеек делаю в ручную, в которой убираю параметры из заголовков, рисую данные в ячейках в соответствии с форматом (например логические показываю в виде галочки checkbox).

ну и соответственно, реализована сортировка по любой колонке по целчку мышкой по заголовку.

т.к. сортировка используется много где, непосредственно сортировка реализована в отдельной процедуре, а непосредственно на гриде:

Код


procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Coord: TGridCoord;
begin
    Coord := StringGrid1.MouseCoord(X, Y);
    if Coord.Y = 0 then
      Global.SortGrid(StringGrid1, Coord.X);\\ это процедура сортировки в общем модуле
  end;

ну и непосредственно сортировка:

Код


procedure SortGrid(Grid: TStringGrid; Col: integer);
var
  SortType, i, j, step: integer;
  buf: string;
  sBuf1, sBuf2: string;
  dBuf1, dBuf2: TDateTime;
  fBuf1, fBuf2: real;
  flag: boolean;
begin
    buf := Grid.Cells[Col, 0];
    SortType := 0; // строка
    if pos(' - ', buf) <> 0 then
    begin
      buf := copy(buf, 1, pos(' - ', buf) - 1);
      if (pos('int', buf) <> 0) or (pos('float', buf) <> 0) or(pos('check', buf) <> 0) then
        SortType := 1; // число
      if (pos('dat', buf) <> 0) then
        SortType := 2; // датавремя
    end;
    if SortType = 0 then
    begin
      // сортировка по строковым правилам
      step := Grid.RowCount div 2;
      while step > 0 do
      begin
        flag := true;
        while flag do
        begin
          flag := false;
          for i := 1 to Grid.RowCount - step - 1 do
          begin
            try
              sBuf1 := trim(Grid.Cells[Col, i]);
            except
              sBuf1 := '';
            end;
            try
              sBuf2 := trim(Grid.Cells[Col, i + step]);
            except
              sBuf2 := '';
            end;
            Application.ProcessMessages;
            if sBuf1 > sBuf2 then
            begin
              flag := true;
              for j := 0 to Grid.ColCount do
              begin
                buf := Grid.Cells[j, i];
                Grid.Cells[j, i] := Grid.Cells[j, i + step];
                Grid.Cells[j, i + step] := buf;
              end;
            end;
          end;
        end;
        step := step div 2;
      end;
    end;
    if SortType = 1 then
    begin
      // сортировка по числовым правилам
      step := Grid.RowCount div 2;
      while step > 0 do
      begin
        flag := true;
        while flag do
        begin
          flag := false;
          for i := 1 to Grid.RowCount - step - 1 do
          begin
            try
              fBuf1 := StrToFloat(Grid.Cells[Col, i]);
            except
              fBuf1 := 0;
            end;
            try
              fBuf2 := StrToFloat(Grid.Cells[Col, i + step]);
            except
              fBuf2 := 0;
            end;
            Application.ProcessMessages;
            if fBuf1 > fBuf2 then
            begin
              flag := true;
              for j := 0 to Grid.ColCount do
              begin
                buf := Grid.Cells[j, i];
                Grid.Cells[j, i] := Grid.Cells[j, i + step];
                Grid.Cells[j, i + step] := buf;
              end;
            end;
          end;
        end;
        step := step div 2;
      end;
    end;

    if SortType = 2 then
    begin
      // сортировка по правилам датывремени
      step := Grid.RowCount div 2;
      while step > 0 do
      begin
        flag := true;
        while flag do
        begin
          flag := false;
          for i := 1 to Grid.RowCount - step - 1 do
          begin
            try
              dBuf1 := StrToDateTime(Grid.Cells[Col, i]);
            except
              dBuf1 := 0;
            end;
            try
              dBuf2 := StrToDateTime(Grid.Cells[Col, i + step]);
            except
              dBuf2 := 0;
            end;
            Application.ProcessMessages;
            if dBuf1 > dBuf2 then
            begin
              flag := true;
              for j := 0 to Grid.ColCount do
              begin
                buf := Grid.Cells[j, i];
                Grid.Cells[j, i] := Grid.Cells[j, i + step];
                Grid.Cells[j, i + step] := buf;
              end;
            end;
          end;
        end;
        step := step div 2;
      end;
    end;
end;

ну и до кучи процедура отрисовки ячейки (свойство DefaultDrawing отключить!):

Код


procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  s, params: string;
  format: Cardinal;
  Header: string;
  r: TRect;
  step: Integer;
  style, TypeButton: word;
  sg: TStringGrid;
begin
    sg := TStringGrid(Sender);
    r := Rect;
    step := -1;
    r.Left := r.Left + step;
    r.Top := r.Top + step;
    r.Right := r.Right - step;
    r.Bottom := r.Bottom - step;
    s := sg.Cells[ACol, ARow];
    Header := sg.Cells[ACol, 0];
    params := '';
    if pos(' - ', Header) <> 0 then
    begin
      params := copy(Header, 1, pos(' - ', Header) - 1);
      Header := copy(Header, pos(' - ', Header) + 3, length(Header));
    end;
    if (ARow = 0) or (ACol = 0) then
    begin
      // заголовок
      sg.Canvas.Font.Color := clWindowText;
      sg.Canvas.Font.style := [fsBold];
      sg.Canvas.Brush.Color := clBtnFace;
      sg.Canvas.Pen.Color := clBlack;
      sg.Canvas.Pen.style := psSolid;
      format := DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE;
      if ARow = 0 then
        s := Header;
    end
    else
    begin
      // Рисуем основное поле
      sg.Canvas.Font.Color := clWindowText;
      sg.Canvas.Brush.Color := clWindow;
      sg.Canvas.Font.style := [];
      sg.Canvas.Pen.Color := clSilver;
      sg.Canvas.Pen.style := psDot;
      format := DT_LEFT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE;
    end;
    sg.Canvas.FillRect®;
    sg.Canvas.Rectangle®;
    if sg.Canvas.TextWidth(s) > sg.ColWidths[ACol] - 2 then
      sg.ColWidths[ACol] := sg.Canvas.TextWidth(s) + 2;
    if pos('hidden', params) <> 0 then
      sg.ColWidths[ACol] := -1;
    if (pos('check', params) <> 0) and (ARow > 0) then
    begin
      if sg.Cells[ACol, ARow] = '1' then
        style := DFCS_CHECKED
      else
        style := DFCS_BUTTONCHECK;
      TypeButton := DFCS_BUTTONCHECK;
      r.Left := Rect.Left + ((Rect.Right - Rect.Left) div 2) -
        (Global.CheckSize div 2);
      r.Top := Rect.Top + ((Rect.Bottom - Rect.Top) div 2) -
        (Global.CheckSize div 2);
      r.Right := Rect.Left + ((Rect.Right - Rect.Left) div 2) -
        (Global.CheckSize div 2) + Global.CheckSize;
      r.Bottom := Rect.Top + ((Rect.Bottom - Rect.Top) div 2) -
        (Global.CheckSize div 2) + Global.CheckSize;
      DrawFrameControl(sg.Canvas.Handle, r, DFC_BUTTON, TypeButton or style);
    end
    else
      DrawText(sg.Canvas.Handle, PChar(s), -1, Rect, format);
    if gdFocused in State then
      sg.Canvas.DrawFocusRect(Rect);
end;

Надеюсь поможет кому-нибудь. Со своей стороны могу попросить помощи в реализации иной задачи: необходимо добавить фильтрацию на этот грид.
интерфейс вижу таким:

Если в параметрах есть 'filter' - значит по колонке возможна фильтрация и надо нарисовать кнопку-раскрывашку как у комбобокса (это ерунда, а не вопрос).
при клике мышкой смотреть попал на раскрывашку или мимо. Если мимо, то сортировать по приведенному выше алгоритму. Если попал, то показать а-ля чекбокс, заполненный всеми возможными значениями из этого столбца. и кнопки "Отметить все", "Снять все отметки", "Инвертировать выбор", "ОК", "Отмена"

по жамку на "ОК" пробежать по стобцу и установить высоту строки -1 для всех, неудовлетворяющих фильтру.

Сложностями вижу алгоритм применения фильтра при условии фильтрации по нескольким колонкам. Подсказки как реализовать все остальное не требуются.

M
MetalFan

Пользуемся подсветкой кода!

Это сообщение отредактировал(а) MetalFan - 28.6.2012, 15:07

Qu1nt

Дата 27.6.2012, 17:20 (ссылка)

(голосов:5)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 602
Регистрация: 13.1.2007

Репутация: 22
Всего: 50

Это жесть.

Akella

Дата 28.6.2012, 11:30 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 8
Всего: 329

devitchenskiy, читать до просветления
http://forum.vingrad.ru/forum/topic-353769.html

отредактируй своё сообщение, оставь только нужную здесь, проблемную часть, оберни код в теги

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »