{---------------------------------------------|
| Модуль для работы с одномерными массивами   |
|                                             |
|---------------------------------------------}

Unit ARRAYS;
Interface
Const
 {Video}
 RText=0;
 RGraph=1;
 {Visible}
 RealkeyV=1;


Type
 TElem = Integer;
 ArrType = array[1..1] of TElem;
 TArrayWork = Object
               Arr:^ArrType;

               Private
               SizeOfArray:Word;
               procedure swap (i, j : word);
               procedure sort (n, t : word);

               Public
               Constructor INIT;
               Procedure   SetSizeArray(_Size:word);
               Function    GetSizeArray:Word;
               Procedure   EnteringArray(visible:Byte;VideoMode:Byte);
               Procedure   PrintCRTarray(Videomode:byte);
               Procedure   QSort(left,right:integer);
               Procedure   HSort;
               Function    GetMaxElem:Telem;
               Function    GetMinElem:Telem;
               Function    GetNumMaxElem:Word;
               Function    GetNumMinElem:Word;
               Function    ElemInArray(T:Telem):Word;
               Procedure   InvertArray;

               Destructor  Done;
              End;

Implementation
Uses CRT,Graph;
Constructor TArrayWork.INIT;
begin
 GetMem(arr,SizeOfArray*SizeOf(TElem));
end;

procedure TArrayWork.swap (i, j : word);
var
 t : TELEM;
begin
 t    := arr^[i];
 arr^[i] := arr^[j];
 arr^[j] := t
end;

procedure TArrayWork.sort (n, t : word);
begin
 while ((t shl 1+1 <= n) and (arr^[t shl 1+1] > arr^[t]) or (t shl 1 <= n) and (arr^[t shl 1] > arr^[t])) do
 begin
  if (arr^[t shl 1+1] >= arr^[t shl 1]) and (t shl 1 +1 <= n) then
  begin
   swap (t shl 1 +1, t);
   t := t shl 1+1
  end else
  begin
   swap (t shl 1, t);
   t := t shl 1
  end
 end;
end;

procedure TArrayWork.HSort;
var i:word;
begin
for i :=SizeOfArray  downto 1 do sort (SizeOfArray, i);
 for i := SizeOfArray downto 1 do
 begin
  swap (1, i);
  sort (i-1, 1)
 end;
end;

Procedure TArrayWork.SetSizeArray(_Size:word);
begin
 SizeOfArray:=_size
end;
Function TArrayWork.GetSizeArray:word;
begin
 GetSizeArray:= SizeOfArray
end;

Procedure TArrayWork.EnteringArray(visible:Byte;VideoMode:Byte);
Var
 TecEl,ec:Word;
 OElem:Byte;
 TEO:Telem;
 otr_:boolean;
begin
 For TecEl:=1 to SizeOfArray do
 begin
  arr^[TecEl]:=0;
  otr_:=false;
  teo:=0;
  repeat {ввод очередного числа посимвольно}
   OElem:=ORD(readkey);
   If (oelem=8) or (oelem=0) Or (OElem=45) or ( (OElem>=48) and (OElem<=57)) then
   Begin
    If OELEM=0 then OELEM:=ORD(readkey);
    If OELEM=8 then
    begin
     teo:=teo div 10;
     If  (visible= RealkeyV) and (Videomode=RText) then GOTOXY(GetX-1,GetY);
    end;
    If visible= RealkeyV then
    begin
     If Videomode=RText then write(CHR(Oelem));
     if VideoMode=RGraph then outtext(CHR(oelem));
    end;
    If (OElem<>45) then teo:=teo*10+OElem-48;
    If OElem=45 then otr_:=true;
   end; {IF}
   If (visible<> RealkeyV) and (visible<>0) and (VideoMode=RText) then
   begin
    If Videomode=RText then write(CHR(visible));
    if VideoMode=RGraph then outtext(CHR(visible));
   end;
  until NOT ((OELEM=8) or(OElem=45) or ( (OElem>=48) and (OElem<=57))) ;
  arr^[TecEl]:=teo;
  If otr_ then arr^[TecEl]:=-arr^[TecEl];
  If visible= RealkeyV then
  begin
   If Videomode=RText then writeln;
  end;
 end; {FOR}
end;
Procedure TArrayWork.PrintCRTarray(VideoMode:byte);
Var
 I:Word;
 s:string;
begin
 For i:=1 to SizeOfArray do
 begin
  Case VideoMode Of
   RTEXT: write(arr^[i],' ');
   RGRAPH: begin
            s:='';
            str(arr^[i],s);
            s:=s+' ';
            OutText(s);
           end;
  end {case}
 end
end;

procedure TArrayWork.QSort(left,right:integer);
var
 l,r:integer;
 B:TElem;
begin
 l:=left;
 r:=right;
 B:=arr^[l];
 repeat
  while (arr^[r]>=B) and (l<r) do r:=r-1;
  arr^[l]:=arr^[r];
  while (arr^[l]<=B) and (l<r) do l:=L+1;
  arr^[r]:=arr^[l]
 until r=l;
 arr^[l]:=B;
 If left<L-1 then QSORT(left,l-1);
 If r+1<right then QSort(r+1,right);
end;


Function TArrayWork.GetMaxElem:Telem;
var
 _Max_:Telem;
 I:word;
begin
 I:=1;
 _MAX_:=arr^[I];
 While I<=SizeOfArray do
 begin
  If arr^[i]>_MaX_ then _MAX_:=arr^[i];
  INC(I,1)
 end;
 GetMaxElem:=_MAX_
end;

Function TArrayWork.GetMinElem:Telem;
var
 _MIN_:Telem;
 I:word;
begin
 I:=1;
 _MIN_:=arr^[I];
 While I<=SizeOfArray do
 begin
  If arr^[i]<_MIN_ then _MIN_:=arr^[i];
  INC(I,1)
 end;
 GetMINElem:=_MIN_
end;

Function TArrayWork.GetNumMaxElem:Word;
var
 _Max_:Word;
 I,saveI:word;
begin
 I:=1; saveI:=1;
 _MAX_:=arr^[I];
 While I<=SizeOfArray do
 begin
  If arr^[i]>_MaX_ then begin _MAX_:=arr^[i]; saveI:=i end;
  INC(I,1)
 end;
 GetnumMaxElem:=SaveI
end;

Function TArrayWork.GetNumMinElem:Word;
var
 _MIN_:Telem;
 I,SaveI:word;
begin
 I:=1; SAveI:=1;
 _MIN_:=arr^[I];
 While I<=SizeOfArray do
 begin
  If arr^[i]<_MIN_ then begin _MIN_:=arr^[i]; saveI:=i end;
  INC(I,1)
 end;
 GetnumMINElem:=SaveI
end;

Function TArrayWork.ElemInArray(T:Telem):Word;
var
 I:Word;
 Ent:boolean;
begin
 I:=1;
 Ent:=False;
 While (I<=SizeOfArray) and (Ent=false) do
 begin
  If arr^[i]=t then begin ent:=true; ElemInArray:=I end;
  Inc(I,1)
 end;
 If ent=false then eleminarray:=0
end;

procedure TArrayWork.InvertArray;
Var
 I:Word;
begin
 For I:=1 to (SizeOfArray div 2) do Swap(i,SizeOfArray+1-i)
End;





Destructor TArrayWork.Done;
Begin
 FreeMem(arr,SizeOfArray*SizeOf(TElem));
End;

Begin
End.