old/PAS/!Other/oarrFunc.pas

CONST
  ArraySize = 7;

type
  ref = ^real;
  vec = array [1..ArraySize] of ref;

{------------------------------------}
function MaxX(var X:vec):real;
var
 cm:real;
 i:1..ArraySize;
begin
 cm :=-MaxInt;
 for i:=1 to ArraySize do
   if X[i]^ > cm then cm := X[i]^;
 MaxX := cm;
end; {MaxX}
{--------------------------------}
Function SameX(var X:vec):boolean;
var
  ret:boolean;
  i,j:1..ArraySize;
begin
  ret:=false;
  for i:=1 to ArraySize do
    for j:=1 to ArraySize do
      if (j <> i) and (X[i]=X[j]) then ret:=true;
  SameX:=ret;
end;{SameX}
{--------------------------------}
Procedure UniqueX(var X:vec);
var
  i,j:1..ArraySize;
begin
  for i:=1 to ArraySize do
   for j:=1 to ArraySize do
     if (I<>J) and (X[j]^=X[i]^) and (X[j]<>X[i]) then X[j]:=X[i];
end;{UniqueX}
{--------------------------------}
Procedure ReadArray(var X:vec);
var
  i : 1..ArraySize;
begin
  for i := 1 to ArraySize do
   begin
     if X[i] = nil then New(X[I]);
     Read(X[i]^);
   end;
end;{ReadArray}
{--------------------------------}
Procedure WriteArray(var X:vec);
var
  i : 1..ArraySize;
begin
  for i := 1 to ArraySize do
     WriteLn(LongInt(X[i]),' --> ',X[i]^:4:3);
end;{WriteArray}
{---------------------------------}

Var
  X : vec;
BEGIN
  WriteLn('Введите ',ArraySize, ' чисел:');
  ReadArray(X);
  WriteLn('Максимальное: ',MaxX(X):0:4);
  WriteLn('Массив, до выполнения процедуры Unique');
  WriteArray(X);
  UniqueX(X);
  WriteLn('Массив, после выполнения процедуры Unique');
  WriteArray(X);
  if SameX(X) then
   WriteLn('Есть элементы с одинаковыми ссылками')
  else
   WriteLn('Нет элементов с одинаковыми ссылками');
END.