unit FMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids;
type
TArr= array of integer;
TMat= array of TArr;
TForm1 = class(TForm)
sg: TStringGrid;
en: TEdit;
em: TEdit;
Button1: TButton;
Button2: TButton;
SG2: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
n,m: integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//Написал для теста (больше не используется)
{function CompareRows(Mat: TMat; CustomData: Pointer; i, j: integer): integer;
//if a>b then res=1
//if a=b then res=0
//if a<b then res=-1
var k: integer;
iRow, jRow: TArr;
begin result:=0;
iRow:=Mat[i];
jRow:=Mat[j];
for k:=0 to High(iRow) do begin
if (iRow[k]>0)and(jRow[k]=0) then begin result:=1; exit end;
if (iRow[k]=0)and(jRow[k]>0) then begin result:=-1; exit end;
end;
end;}
//Функция сравнения строк матрицы -
// в данном случае просто сравнивает два целых числа,
// сопоставленных со строками
function CompareRows(Mat: TMat; CustomData: Pointer; i, j: integer): integer;
//if a>b then res=1
//if a=b then res=0
//if a<b then res=-1
begin
result:=TArr(CustomData)[i]-TArr(CustomData)[j];
end;
//Процедура сортировки строк матрицы, использующая для сравнения
// функцию CompareRows (сортировка неустойчивая - вариант HeapSort)
//Заполняет массив-оглавление Indices
procedure SortMat(Mat: TMat; CustomData: Pointer; Indices: TArr; Len: Integer=-1);
var
i, k, t: integer;
Tmp: integer;
begin
if (Len<0) then begin
Len:=Length(Mat);
end;
i := 2;
repeat
t := i;
while t<>1 do begin
k := t shr 1;
if CompareRows(Mat, CustomData, Indices[k-1], Indices[t-1])>=0 then begin
t := 1;
end else begin
Tmp := Indices[k-1];
Indices[k-1] := Indices[t-1];
Indices[t-1] := Tmp;
t := k;
end;
end;
inc(i);
until not (i<=Len);
i := Len-1;
repeat
Tmp := Indices[i];
Indices[i] := Indices[0];
Indices[0] := Tmp;
t := 1;
while t<>0 do begin
k := t shl 1;
if k>i then begin
t := 0;
end else begin
if k<i then begin
if CompareRows(Mat, CustomData, Indices[k], Indices[k-1])>0 then inc(k);
end;
if CompareRows(Mat, CustomData, Indices[t-1], Indices[k-1])>=0 then begin
t := 0;
end else begin
Tmp := Indices[k-1];
Indices[k-1] := Indices[t-1];
Indices[t-1] := Tmp;
t := k;
end;
end;
end;
dec(i);
until not (i>=1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: integer;
indices: TArr;
EqNums: TArr;
Mat: TMat;
Row: TArr;
//Процедура заполнения массива EqNums
procedure FillEqNums;
var
i, j, k, Value, Count: integer;
Used: array of boolean;
begin
//Вообще это надо делать через словарь! Будет код в две строчки.
// Но мы обойдёмся, правда будет неэффективно.
SetLength(EqNums, n);
for i:=0 to n-1 do begin
Row:=Mat[i];
SetLength(Used, m);
for j := 0 to m-1 do begin
if not Used[j] then begin
Value:=Row[j];
Count:=0;
for k:=0 to m-1 do
if Row[k]=Value then begin
inc(Count);
Used[k]:=true;
end;
end;//not Used
if EqNums[i]<Count then EqNums[i]:=Count;
end;
finalize(Used);
end;
end;
begin
SG2.RowCount:=n+1;
SG2.ColCount:=m+1;
//Заполняем исходную матрицу
SetLength(Mat, n, m);
for i:=1 to n do begin
for j := 1 to m do
Mat[i-1,j-1]:=StrToInt(SG.Cells[j,i]);
end;
//Заполняем массив EqNums с макcимальными количествами одинаковых элементов
// в строках матрицы Mat
FillEqNums;
//Заполняем оглавление в естественном порядке
SetLength(Indices, n);
for j:=0 to n-1 do Indices[j]:=j;
//Сортируем матрицу
SortMat(Mat, EqNums, Indices, n);
//Выводим отсортированную матрицу, используя сформированное оглавление
for i:=1 to n do begin
for j := 1 to m do
SG2.Cells[j,i]:=IntToStr(Mat[Indices[i-1],j-1]);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, j: integer;
begin
sg.RowCount:=strtoint(en.text)+1;
sg.ColCount:=strtoint(em.text)+1;
n:=strtoint(en.text);
m:=strtoint(em.text);
for i:=1 to n do begin
for j := 1 to m do
SG.Cells[j,i]:='0';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i, j: integer;
begin
n:=SG.RowCount-1;
m:=SG.ColCount-1;
for i:=1 to n do begin
for j := 1 to m do
SG.Cells[j,i]:='0';
end;
end;
end.
. Естественно, что с готовыми классами проще и нагляднее