Вопрос # 1 173: …ажаемые эксперты! Имеется таблица StringGrid. Необходимо отсортироват… (Алгоритмы, преобразования)

Вопросы: 0
Ответы: 0
Мини-форумы: 0

Онлайн на сайте: 130 (3404)
Онлайн в IRC: 2 (17)
Последние новости:
8 июля 2023
Последний вопрос:
9 августа 2022, 09:39
Последний ответ:
29 марта 2018, 23:32

procedure GridSort(StrGrid: TStringGrid; NoColumn: Integer); var Line, PosActual: Integer; Row: TStrings; begin Renglon := TStringList.Create; for Line := 1 to StrGrid.RowCount - 1 do begin PosActual := Line; Row.Assign(TStringlist(StrGrid.Rows[PosActual])); while True do begin if (PosActual = 0) or (StrToInt(Row.Strings[NoColumn - 1]) >= StrToInt(StrGrid.Cells[NoColumn - 1, PosActual - 1])) then Break; StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual - 1]; Dec(PosActual); end; if StrToInt(Row.Strings[NoColumn - 1]) < StrToInt(StrGrid.Cells[NoColumn - 1, PosActual]) then StrGrid.Rows[PosActual] := Row; end; Renglon.Free; end;

Мини-форум вопроса

Всего сообщений: 2; последнее сообщение — 4 декабря 2007, 10:44; участников в обсуждении: 1.

Feniks (статус: Бакалавр), 4 декабря 2007, 10:24 [#1]:

Имя папки примера Threads.

Feniks (статус: Бакалавр), 4 декабря 2007, 10:44 [#2]:

Вот еще несколько примеров по сортировки StringGrid-а.
Пример №1.

<pre class="delphi-1" style="font-family:monospace;">Procedure GridSort(StrGrid: TStringGrid; NoColumn: Integer); 
Var Line, PosActual: Integer; 
 Row: TStrings; 
begin 
Renglon := TStringList.Create; 
For Line := 1 to StrGrid.RowCount-1 do 
Begin 
 PosActual := Line; 
 Row.Assign(TStringlist(StrGrid.Rows[PosActual])); 
 While True do 
 Begin 
 If (PosActual = 0) Or (StrToInt(Row.Strings[NoColumn-1]) >= 
 StrToInt(StrGrid.Cells[NoColumn-1,PosActual-1])) then 
 Break; 
 StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual-1]; 
 Dec(PosActual); 
 End; 
 If StrToInt(Row.Strings[NoColumn-1]) < StrToInt(StrGrid.Cells[NoColumn-1,PosActual]) then 
 StrGrid.Rows[PosActual] := Row; 
End; 
Renglon.Free; 
end;</pre>

Пример №2.

<pre class="delphi-1" style="font-family:monospace;">type TStringGridExSortType = (srtAlpha,srtInteger,srtDouble); 
 
procedure GridSort(SG : TStringGrid; ByColNumber,FromRow,ToRow : integer; 
 SortType : TStringGridExSortType = srtAlpha); 
var Temp : TStringList; 
 
 function SortStr(Line : string) : string; 
 var RetVar : string; 
 begin 
 case SortType of 
 srtAlpha : Retvar := Line; 
 srtInteger : Retvar := FormatFloat('000000000',StrToIntDef(trim(Line),0)); 
 srtDouble : try 
 Retvar := FormatFloat('000000000.000000',StrToFloat(trim(Line))); 
 except 
 RetVar := '0.00'; 
 end; 
 end; 
 
 Result := RetVar; 
 end; 
 
 // Рекурсивный QuickSort 
 procedure QuickSort(Lo,Hi : integer; CC : TStrings); 
 
 procedure Sort(l,r: integer); 
 var i,j : integer; 
 x : string; 
 begin 
 i := l; j := r; 
 x := SortStr(CC[(l+r) DIV 2]); 
 repeat 
 while SortStr(CC[i]) < x do inc(i); 
 while x < SortStr(CC[j]) do dec(j); 
 if i <= j then begin 
 Temp.Assign(SG.Rows[j]); // Меняем местами 2 строки
 SG.Rows[j].Assign(SG.Rows[i]); 
 SG.Rows[i].Assign(Temp); 
 inc(i); dec(j); 
 end; 
 until i > j; 
 if l < j then sort(l,j); 
 if i < r then sort(i,r); 
 end; 
 
 begin {quicksort}; 
 Sort(Lo,Hi); 
 end; 
 
begin 
Temp := TStringList.Create; 
QuickSort(FromRow,ToRow,SG.Cols[ByColNumber]); 
Temp.Free; 
end;</pre>

Пример №3.
Сортировка по клику на заголовке столбца

<pre class="delphi-1" style="font-family:monospace;">type
 TMoveSG = class(TCustomGrid); // reveals protected MoveRow procedure 
 
{...}
 
procedure SortGridByCols(Grid: TStringGrid; ColOrder: array of Integer);
var
 i, j: Integer;
 Sorted: Boolean;
 
function Sort(Row1, Row2: Integer): Integer;
var
 C: Integer;
begin
 C := 0;
 Result := AnsiCompareStr(Grid.Cols[ColOrder[C]][Row1], Grid.Cols[ColOrder[C]][Row2]);
 if Result = 0 then
 begin
 Inc(C);
 while (C <= High(ColOrder)) and (Result = 0) do
 begin
 Result := AnsiCompareStr(Grid.Cols[ColOrder[C]][Row1],
 Grid.Cols[ColOrder[C]][Row2]);
 Inc(C);
 end;
 end;
end;
 
begin
 if SizeOf(ColOrder) div SizeOf(i) <> Grid.ColCount then Exit;
 
 for i := 0 to High(ColOrder) do
 if (ColOrder[i] < 0) or (ColOrder[i] >= Grid.ColCount) then Exit;
 
 j := 0;
 Sorted := False;
 repeat
 Inc(j);
 with Grid do
 for i := 0 to RowCount - 2 do
 if Sort(i, i + 1) > 0 then
 begin
 TMoveSG(Grid).MoveRow(i + 1, i);
 Sorted := False;
 end;
 until Sorted or (j = 1000);
 Grid.Repaint;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 { Sort rows based on the contents of two or more columns. 
 Sorts first by column 1. If there are duplicate values 
 in column 1, the next sort column is column 2 and so on...}
 SortGridByCols(StringGrid1, [1, 2, 0, 3, 4]);
end;</pre>

Пример №4.

<pre class="delphi-1" style="font-family:monospace;">procedure SortStringGrid(var GenStrGrid: TStringGrid; ThatCol: Integer);
const
 // Define the Separator 
TheSeparator = '@';
var
 CountItem, I, J, K, ThePosition: integer;
 MyList: TStringList;
 MyString, TempString: string;
begin
 // Give the number of rows in the StringGrid 
CountItem := GenStrGrid.RowCount;
 //Create the List 
MyList := TStringList.Create;
 MyList.Sorted := False;
 try
 begin
 for I := 1 to (CountItem - 1) do
 MyList.Add(GenStrGrid.Rows[I].Strings[ThatCol] + TheSeparator +
 GenStrGrid.Rows[I].Text);
 //Sort the List 
 Mylist.Sort;
 
 for K := 1 to Mylist.Count do
 begin
 //Take the String of the line (K – 1) 
 MyString := MyList.Strings[(K - 1)];
 //Find the position of the Separator in the String 
 ThePosition := Pos(TheSeparator, MyString);
 TempString := '';
 {Eliminate the Text of the column on which we have sorted the StringGrid}
 TempString := Copy(MyString, (ThePosition + 1), Length(MyString));
 MyList.Strings[(K - 1)] := '';
 MyList.Strings[(K - 1)] := TempString;
 end;
 
 // Refill the StringGrid 
 for J := 1 to (CountItem - 1) do
 GenStrGrid.Rows[J].Text := MyList.Strings[(J - 1)];
 end;
 finally
 //Free the List 
 MyList.Free;
 end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 // Sort the StringGrid1 on the second Column 
// StringGrid1 nach der 1. Spalte sortieren 
SortStringGrid(StringGrid1, 1);
end;</pre>

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 173

Мини-форум вопроса

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 173

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом