Сортировка StringGrid

=== Сортировка StringGrid ===
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;
ID: 00598
----
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;
Source: Взято из http://forum.sources.ru
ID: 00599
----
Сортировка по клику на заголовке столбца
type
 TMoveSG = class(TCustomGrid); // reveals protected MoveRow procedure
implementation
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;
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;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00681
----
unit olimp_;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Grids, StdCtrls;
type
 TForm1 = class(TForm)
 Tabl: TStringGrid;
 Button1: TButton;
 Label1: TLabel;
 procedure FormActivate(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormActivate(Sender: TObject);
begin
 tabl.Cells[0, 0] := 'Страна';
 tabl.Cells[1, 0] := 'Золотых';
 tabl.Cells[2, 0] := 'Серебряных';
 tabl.Cells[3, 0] := 'Бронзовых';
 tabl.Cells[4, 0] := 'Всего';
 tabl.Cells[5, 0] := 'Баллов';
 tabl.Cells[0, 1] := 'Австралия';
 tabl.Cells[0, 2] := 'Беларусь';
 tabl.Cells[0, 3] := 'Великобритания';
 tabl.Cells[0, 4] := 'Германия';
 tabl.Cells[0, 5] := 'Италия';
 tabl.Cells[0, 6] := 'Китай';
 tabl.Cells[0, 7] := 'Корея';
 tabl.Cells[0, 8] := 'Куба';
 tabl.Cells[0, 9] := 'Нидерланды';
 tabl.Cells[0, 10] := 'Россия';
 tabl.Cells[0, 11] := 'США';
 tabl.Cells[0, 12] := 'Франция';
 tabl.Cells[0, 13] := 'Япония';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 c, r: integer; // номер колонки и строки таблицы
 s: integer; // всего медалей у команды
 p: integer; // очков у команды
 m: integer; // номер строки с максимальным количеством очков
 buf: array[0..5] of string; // буфер для обмена строк
 i: integer; // номер строки используется во время сортировки
begin
 for r := 1 to tabl.rowcount do // обработать все строки
 begin
 s := 0;
 // вычисляем общее кол-во медалей
 for c := 1 to 3 do
 if tabl.cells[c, r] <> then
 s := s + StrToInt(tabl.cells[c, r])
 else
 tabl.cells[c, r] := '0';
 // вычисляем количество очков
 p := 7 * StrToInt(tabl.cells[1, r]) +
 6 * StrToInt(tabl.cells[2, r]) +
 5 * StrToInt(tabl.cells[3, r]);
 // вывод результата
 tabl.cells[4, r] := IntToStr(s); // всего медалей
 tabl.cells[5, r] := IntToStr(p); // очков
 end;
 // сортировка таблицы по убыванию в соответствие
 // с количеством баллов (по содержимому 5-ого столбца)
 // сортировка методом выбора
 for r := 1 to tabl.rowcount - 1 do
 begin
 m := r; // максимальный элемент - в r-ой строке
 for i := r to tabl.rowcount - 1 do
 if StrToInt(tabl.cells[5, i]) > StrToInt(tabl.cells[5, m]) then
 m := i;
 if r <> m then
 begin // обменяем r-ую и m-ую строки таблицы
 for c := 0 to 5 do
 begin
 buf[c] := tabl.Cells[c, r];
 tabl.Cells[c, r] := tabl.Cells[c, m];
 tabl.Cells[c, m] := buf[c];
 end;
 end;
 end;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 00682
----
program H;
uses WinCrt, SysUtils;
const
 min = 10;
 max = 13;
 maxHeap = 1 shl max;
type
 heap = array [1..maxHeap] of integer;
 heapBase = ^heap;
var
 currentSize, heapSize: integer;
 A: heapBase;
procedure SwapInts(var a, b: integer);
var
 t: integer;
begin
 t := a;
 a := b;
 b := t
end;
procedure InitHeap(size: integer);
var
 i: integer;
begin
 heapSize := size;
 currentSize := size;
 Randomize;
 for i := 1 to size do
 A^[i] := Random(size) + 1;
end;
procedure Heapify(i: integer);
var
 left, right, largest: integer;
begin
 largest := i;
 left := 2 * i;
 right := left + 1;
 if left <= heapSize then
 if A^[left] > A^[i] then
 largest := left;
 if right <= heapSize then
 if A^[right] > A^[largest] then
 largest := right;
 if largest <> i then
 begin
 SwapInts (A^[largest], A^[i]);
 Heapify (largest)
 end
end;
procedure BuildHeap;
var
 i: integer;
begin
 for i := heapSize div 2 downto 1 do
 Heapify (i)
end;
procedure HeapSort;
var
 i: integer;
begin
 BuildHeap;
 for i := currentSize downto 2 do
 begin
 SwapInts (A^[i], A^[1]);
 dec (heapSize);
 Heapify (1)
 end;
end;
type
 TAvgTimes = array [min..max] of TDateTime;
var
 sTime, eTime, tTime: TDateTime;
 i, idx, size: integer;
 avgTimes: TAvgTimes;
begin
 tTime := 0;
 i := min;
 size := 1 shl min;
 new (A);
 while i <= max do
 begin
 for idx := 1 to 10 do
 begin
 InitHeap (size);
 sTime := Time;
 HeapSort;
 eTime := Time;
 tTime := tTime + (eTime - sTime)
 end;
 avgTimes[i] := tTime / 10.0;
 inc (i);
 size := size shl 1;
 end;
end.
Source: http://delphiworld.narod.ru/
ID: 01106