old/PAS/Matrixes/MTRXSRT.PAS

Uses CRT;
Const
  M=4;
  N=3;
  inpt = 'mtrxsort.txt';
  outpt = 'mtrxrslt.txt';
Var
 ar : array[1..N,1..M] of integer;
{--------========================---------}
Function GetM(i : integer):integer;forward;
Function GetN(i : integer):integer;forward;
{--------========================---------}
Function GetMaxLength:integer;
Var i,max,min : integer;s1,s2:string;
Begin
  max := -MaxInt;
  Min := MaxInt;
  for i := 1 to m*n do begin
    if ar[getN(i),getM(i)] > max then max := ar[getN(i),getM(i)];
    if ar[getN(i),getM(i)] < min then min := ar[getN(i),getM(i)];
  end;
  str(max,s1);
  str(min,s2);
  if length(s1) > length(s2) then
    GetMaxLength := length(s1) + 1
  else
    GetMaxLength := length(s2) + 1;
End;
{------------------------------------}
Procedure ReadFile(fn : string);
Var
  f : text;
  i : 1..M;
  j : 1..N;
Begin
  Assign(f,fn);
  {$I-}
  Reset(f);
  If IOResult <> 0 then
    Repeat
      Write('” ©« ­¥ ­ ©¤¥­, ¢¢¥¤¨â¥ ­®¢®¥ ¨¬ï: ');
      Readln(fn);
      Assign(f,fn);
      Reset(f);
    Until IOResult = 0;
  {$I+}
  for j := 1 to N do
    for i := 1 to M do Read(f,ar[j,i]);
  for j := 1 to N do
    for i := 1 to M do Begin
      GotoXY(i*getMaxLength+5,j+2);
      Write(ar[j,i])
    end;
  Close(f);
End;{ReadFile}
{----------------------------------}
Function GetM(i : integer):integer;
Var tmp : integer;
Begin
  tmp := i mod M;
  if tmp = 0 then GetM := M else GetM := tmp
End;{GetM}
{----------------------------------}
Function GetN(i : integer):integer;
Begin
 if i mod M = 0 then GetN := i div M else
   GetN := i div M + 1
End;{GetM}
{----------------------------------}
Procedure SwapPlace(j :integer);
Var tmp : integer;
Begin
 tmp := ar[GetN(j),GetM(j)];
 ar[GetN(j),GetM(j)] := ar[GetN(j+1),GetM(j+1)];
 ar[GetN(j+1),GetM(j+1)] := tmp;
End;
{-------------------------------}
Procedure SortList;
Var
  i,j : integer;
Begin

For i := m*n downto 2 do
 for j := 1 to i-1 do begin
   if ar[getN(J),GetM(J)] > ar[getN(J+1),GetM(J+1)] then
     SwapPlace(j)
 end;
End;{SortList}
{-----------------------------------}
Procedure WriteResult(fil :string);
Var
  f : text;
  i : 1..M;
  j : 1..N;

Begin
  Assign(f,fil);
  REwrite(f);
  for j := 1 to N do begin
    for i := 1 to M do begin
      Write(f,ar[j,i],'  ');
      GotoXY(i*getmaxlength+5,j+7+n);
      normvideo;
      Write(ar[j,i])
    end;
    WriteLn(f);
  end;
  close(f)
End;{WriteResult}
{---------------------------------}
Begin
 ClrScr;
 ReadFile(inpt);
 SortList;
 WriteResult(outpt);
End.