История изменений

Исправление bormant, 21.09.18 03:18 (текущая версия) :

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

type LessFunc = function (const a, b: TLine): Boolean;

procedure InsSort(var a: array of TLine; n: Integer; IsLess: LessFunc);
var
  t: TLine;
  i, j: Integer;
begin
  for i:=1 to n-1 do begin
    t:=a[i]; j:=i;
    while (j>0) and IsLess(t,a[j-1]) do begin
      a[j]:=a[j-1]; Dec(j);
    end;
    a[j]:=t;
  end;
end;

procedure IsLess(const a, b: TLine; l, r: Integer): Boolean;
begin
  IsLess:=False;
  for l:=l to r do
    if a[l]<b[l] then begin
      IsLess:=True; Exit;
    end else if a[l]>b[l] then Exit;
end;

function ByPhone(const a, b: TLine): Boolean; far;
begin
  ByPhone:=IsLess(a,b,16,24);
end;

function ByName(const a, b: TLine): Boolean; far;
begin
  ByName:=IsLess(a,b,0,15);
end;
...
  InsSort(a,n,ByPhone);
  InsSort(a,n,ByName);

PS. Там в примере выше в IsLess() были пропущены индексы при сравнениях a[j]<b[j] и наоборот, вписать самостоятельно.

Исправление bormant, 21.09.18 03:18:

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

type LessFunc = function (const a, b: TLine): Boolean;

procedure InsSort(var a: array of TLine; n: Integer; IsLess: LessFunc);
var
  t: TLine;
  i, j: Integer;
begin
  for i:=1 to n-1 do begin
    t:=a[i]; j:=i;
    while (j>0) and IsLess(t,a[j-1]) do begin
      a[j]:=a[j-1]; Dec(j);
    end;
    a[j]:=t;
  end;
end;

procedure IsLess(const a, b: TLine; l, r: Integer): Boolean;
begin
  IsLess:=False;
  for l:=l to r do
    if a[l]<b[l] then begin
      IsLess:=True; Exit;
    end else if a[l]>b[l] then Exit;
end;

function ByPhone(const a, b: TLine): Boolean; far;
begin
  ByPhone:=IsLess(a,b,16,24);
end;

function ByName(const a, b: TLine): Boolean; far;
begin
  ByName:=IsLess(a,b,0,23);
end;
...
  InsSort(a,n,ByPhone);
  InsSort(a,n,ByName);

PS. Там в примере выше в IsLess() были пропущены индексы при сравнениях a[j]<b[j] и наоборот, вписать самостоятельно.

Исправление bormant, 21.09.18 03:17:

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

type LessFunc = function (const a, b: TLine): Boolean;

procedure InsSort(var a: array of TLine; n: Integer; IsLess: LessFunc);
var
  t: TLine;
  i, j: Integer;
begin
  for i:=1 to n-1 do begin
    t:=a[i]; j:=i;
    while (j>0) and IsLess(t,a[j-1]) do begin
      a[j]:=a[j-1]; Dec(j);
    end;
    a[j]:=t;
  end;
end;

procedure IsLess(const a, b: TLine; l, r: Integer): Boolean;
begin
  ByPhone:=False;
  for l:=l to r do
    if a[l]<b[l] then begin
      ByPhone:=True; Exit;
    end else if a[l]>b[l] then Exit;
end;

function ByPhone(const a, b: TLine): Boolean; far;
begin
  ByPhone:=IsLess(a,b,16,24);
end;

function ByName(const a, b: TLine): Boolean; far;
begin
  ByName:=IsLess(a,b,0,23);
end;
...
  InsSort(a,n,ByPhone);
  InsSort(a,n,ByName);

PS. Там в примере выше в IsLess() были пропущены индексы при сравнениях a[j]<b[j] и наоборот, вписать самостоятельно.

Исходная версия bormant, 21.09.18 03:15:

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

type LessFunc = function (const a, b: TLine): Boolean;

procedure InsSort(var a: array of TLine; n: Integer; IsLess: LessFunc);
var
  t: TLine;
  i, j: Integer;
begin
  for i:=1 to n-1 do begin
    t:=a[i]; j:=i;
    while (j>0) and IsLess(t,a[j-1]) do begin
      a[j]:=a[j-1]; Dec(j);
    end;
    a[j]:=t;
  end;
end;

procedure IsLess(const a, b: TLine; l, r: Integer): Boolean;
begin
  ByPhone:=False;
  for l:=l to r do
    if a[l]<b[l] then begin
      ByPhone:=True; Exit;
    end else if a[l]>b[l] then Exit;
end;

function ByPhone(const a, b: TLine): Boolean; far;
begin
  ByPhone:=IsLess(a,b,16,24);
end;

function ByName(const a, b: TLine): Boolean; far;
begin
  ByName:=IsLess(a,b,0,23);
end;
...
  InsSort(a,n,ByPhone);
  InsSort(a,n,ByName);

PS. Там в примере выше в IsLess() были пропущены индексы при сравнениях a[j]<b[j] и наоборот, вписать самостоятельно.