old/PAS/Matrixes/MTRXFND.PAS

Uses CRT;
const
  fname = 'mtrxrslt.txt';
  M = 4;
  N = 3;
Var
  ar : array[1..N,1..M] of integer;
  f1 : integer;
  FindM,FindN : integer;
{-----------==================--------------}
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}
{----------------------------------}
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(f : string);
Var
  i : integer;
  f1 : text;

Begin
  Assign(f1,f);
  {$I-}
  Reset(f1);
  If IOResult <> 0 then
    Repeat
      Write('Файл не найден, введите новое имя: ');
      Readln(f);
      Assign(f1,f);
      Reset(f1);
    Until IOResult = 0;
  {$I+}
  for i := 1 to m*n do Read(f1,ar[GetN(i),GetM(I)]);
  for i := 1 to m*n do begin
    GotoXY(getM(i)*getmaxlength+5,GetN(I)+2);
    Write(ar[GetN(i),GetM(I)]);
  end;
  WriteLn;
  WriteLn;
End;{ReadFile}
{------------------------------------}
Function GetValue:integer;
Var s1:string;code,va1:integer;
Begin
 Repeat
  Write('Введите число для поиска в матрице : ');
  ReadLn(s1);
  Val(s1,va1,code);
 Until Code = 0;
 GetValue := va1
End;{GetValue}
{------------------------------------}
Procedure Find(found:integer);
Var
  l,r,tmp,i:integer;
Begin
  l := 1;
  r := m*n;
  while l < r do
    if ar[GetN((l+r) div 2),GetM((l+r) div 2)] >= found then r := (l+r) div 2
    else l := (l+r) div 2+1;
  if found = ar[GetN(r),GetM(R)] then begin
    FindN := GetN(r);
    FindM := GetM(r);
  end
  else FindM := 0
End;{Find}
{----------------------------------}
Procedure WriteResult;
Begin
  if FindM <> 0 then
   begin
    WriteLn('Искомое значение найдено в');
    WriteLn('  строке   : ',FindN);
    WriteLn('  столбце  : ',FindM)
   end
  else
   WriteLn('Искомое значение не найдено')
End;{WriteResult}
{-----------------------------------}
Begin
  ClrScr;
  ReadFile(fname);
  f1 := GetValue;
  Find(f1);
  WriteResult;
  ReadKey
End.