unit Arrays;

INTERFACE

uses SysUtils, Dialogs;

type
  ArrayOfString = array [0..100] of string;
  PArrayOfString = ^ArrayOfString;

  ArrayOfSingle = array [0..100] of single;
  PArrayOfSingle = ^ArrayOfSingle;

  ArrayOfInt = array [0..100] of integer;
  PArrayOfInt = ^ArrayOfInt;

  ArrayOfSmallInt = array [0..100] of smallint;
  PArrayOfSmallInt = ^ArrayOfSmallInt;

  ArrayOfLongInt = array [0..100] of longint;
  PArrayOfLongInt = ^ArrayOfLongInt;

  ArrayOfSingleArrays = array [0..100] of PArrayOfSingle;
  PArrayOfSingleArrays = ^ArrayOfSingleArrays;

  ArrayOfIntArrays = array [0..100] of PArrayOfInt;
  PArrayOfIntArrays = ^ArrayOfIntArrays;

  ArrayOfLongIntArrays = array [0..100] of PArrayOfLongInt;
  PArrayOfLongIntArrays = ^ArrayOfLongIntArrays;

  ArrayOfArraysOfSingleArrays = array [0..100] of PArrayOfSingleArrays;
  PArrayOfArraysOfSingleArrays = ^ArrayOfArraysOfSingleArrays;


  TMyArrayOfSingle = class
  private
    ArrSize : longint;
    ArrData : PArrayOfSingleArrays;
    function  Get(Indeks : longint) : single;
    procedure Put(Indeks : longint; Value : single);
  public
    constructor Create;
    destructor  Destroy; override;
    property    TheValue [N : longint] : single
                read Get  write Put;  default;
    function  SetSize(NumEntries : longint) : boolean;
    function  MaxSize : longint;
    procedure Fill(FillValue : single);
  end;

  TMyArrayOfInt = class
  private
    ArrSize : longint;
    ArrData : PArrayOfIntArrays;
    function  Get(Indeks : longint) : integer;
    procedure Put(Indeks : longint; Value : integer);
  public
    constructor Create;
    destructor  Destroy; override;
    property    TheValue [N : longint] : integer
                read Get  write Put;  default;
    function  SetSize(NumEntries : longint) : boolean;
    function  MaxSize : longint;
    procedure Fill(FillValue : integer);
  end;

  TMyArrayOfLongInt = class
  private
    ArrSize : longint;
    ArrData : PArrayOfIntArrays;
    function  Get(Indeks : longint) : longint;
    procedure Put(Indeks : longint; Value : longint);
  public
    constructor Create;
    destructor  Destroy; override;
    property    TheValue [N : longint] : longint
                read Get  write Put;  default;
    function  SetSize(NumEntries : longint) : boolean;
    function  GetSize : longint;
    function  MaxSize : longint;
    procedure Fill(FillValue : longint);
  end;

  ArrayOfTMyArrayOfSingle = array [0..50] of TMyArrayOfSingle;
  PArrayOfTMyArrayOfSingle = ^ArrayOfTMyArrayOfSingle;

  ArrayOfTMyArrayOfInt = array [0..50] of TMyArrayOfInt;
  PArrayOfTMyArrayOfInt = ^ArrayOfTMyArrayOfInt;

  ArrayOfTMyArrayOfLongInt = array [0..50] of TMyArrayOfLongInt;
  PArrayOfTMyArrayOfLongInt = ^ArrayOfTMyArrayOfLongInt;


IMPLEMENTATION

{$RANGECHECKS OFF}

{----------------------------------}
constructor TMyArrayOfSingle.Create;
begin
   ArrSize := 0;
end;

{----------------------------------}
destructor TMyArrayOfSingle.Destroy;
begin
   SetSize(0);
   inherited Destroy;
end;

{----------------------------------}
function TMyArrayOfSingle.SetSize(NumEntries : longint) : boolean;
var
  I, J, Rows : longint;
begin
   Result := TRUE;

   { clear any existing data in the array(s) }
   if (ArrSize > 0) then begin
     Rows := ((ArrSize-1) div 16000) + 1;
     for I:=Rows-1 downto 0 do begin
        J := 16000;
        if (I = 0) then J := ArrSize - (Rows-1)*16000;
        FreeMem(ArrData^[I], J*sizeof(single));
     end;
     FreeMem(ArrData, Rows * sizeof(PArrayOfSingle));
     ArrSize := 0;
   end;

   { if new size is zero then return TRUE }
   if (NumEntries = 0) then exit;

   { if new size is too large then return FALSE }
   if (NumEntries > 16000*16000) then begin
      Result := FALSE;
      exit;
   end;

   { allocate new memory }
   ArrSize := NumEntries;
   Rows := ((ArrSize-1) div 16000) + 1;
   try
     GetMem(ArrData, Rows*sizeof(PArrayOfSingle));
   except
     on EOutofMemory do begin
       MessageDlg('Out Of Memory Error', mtError, [mbOk], 0);
       Result := FALSE;
       exit;
     end;
   end;
   for I:=0 to Rows-1 do begin
      J := 16000;
      if (I = (Rows-1)) then J := ArrSize - (Rows-1)*16000;
      try
        GetMem(ArrData^[I], J*sizeof(single));
      except
        on EOutOfMemory do begin
          for J := I-1 downto 0 do FreeMem(ArrData^[J], 16000*sizeof(single));
          MessageDlg('Out Of Memory Error', mtError, [mbOk], 0);
          Result := FALSE;
          exit;
        end;
      end;
   end;

end;

{----------------------------------}
function TMyArrayOfSingle.Get(Indeks : longint) : single;
var
   R, C : longint;
begin
   Result := -9e9;
   if (Indeks < 0) then exit;
   if (Indeks > ArrSize-1) then exit;
   R := Indeks div 16000;      { which row? }
   C := Indeks - (R*16000);
   Result := ArrData^[R]^[C];
end;

{----------------------------------}
procedure TMyArrayOfSingle.Put(Indeks : longint; Value : single);
var
   R, C : longint;
begin
   if (Indeks < 0) then exit;
   if (Indeks > ArrSize-1) then exit;
   R := Indeks div 16000;      { which row? }
   C := Indeks - (R*16000);
   ArrData^[R]^[C] := Value;
end;

{----------------------------------}
function TMyArrayOfSingle.MaxSize : longint;
begin
   Result := ArrSize;
end;

{----------------------------------}
procedure TMyArrayOfSingle.Fill(FillValue : single);
var
   I : longint;
begin
   for I:=0 to ArrSize-1 do Put(I, FillValue);
end;


{--------------------------------------------------------------------------}
{----------------------------------}
constructor TMyArrayOfInt.Create;
begin
   ArrSize := 0;
end;

{----------------------------------}
destructor TMyArrayOfInt.Destroy;
begin
   SetSize(0);
   inherited Destroy;
end;

{----------------------------------}
function TMyArrayOfInt.SetSize(NumEntries : longint) : boolean;
var
  I, J, Rows : longint;
begin
   Result := TRUE;

   { clear any existing data in the array(s) }
   if (ArrSize > 0) then begin
     Rows := ((ArrSize-1) div 16000) + 1;
     for I:=Rows-1 downto 0 do begin
        J := 16000;
        if (I = 0) then J := ArrSize - (Rows-1)*16000;
        try
           FreeMem(ArrData^[I], J*sizeof(integer));
        except
            ;   { dummy statement just to clear error condition }
        end;
     end;
        try
           FreeMem(ArrData, Rows * sizeof(PArrayOfInt));
        except
            ;   { dummy statement just to clear error condition }
        end;
     ArrSize := 0;
   end;

   { if new size is zero then return TRUE }
   if (NumEntries = 0) then exit;

   { if new size is too large then return FALSE }
   if (NumEntries > 16000*16000) then begin
      Result := FALSE;
      exit;
   end;

   { allocate new memory }
   ArrSize := NumEntries;
   Rows := ((ArrSize-1) div 16000) + 1;
   try
     GetMem(ArrData, Rows*sizeof(PArrayOfInt));
   except
     on EOutOfMemory do begin
       MessageDlg('Out Of Memory Error', mtError, [mbOk], 0);
       Result := FALSE;
       exit;
     end;
     else begin
       MessageDlg('Unknown error while allocating memory', mtError, [mbOk], 0);
       Result := FALSE;
       exit;
     end;
   end;
   for I:=0 to Rows-1 do begin
      J := 16000;
      if (I = (Rows-1)) then J := ArrSize - (Rows-1)*16000;
      try
        GetMem(ArrData^[I], J*sizeof(integer));
      except
        on EOutOfMemory do begin
          for J := I-1 downto 0 do FreeMem(ArrData^[J], 16000*sizeof(integer));
          MessageDlg('Out Of Memory Error', mtError, [mbOk], 0);
          Result := FALSE;
          exit;
        end;
        else begin
          for J := I-1 downto 0 do FreeMem(ArrData^[J], 16000*sizeof(integer));
          MessageDlg('Unknown error while allocating memory', mtError, [mbOk], 0);
          Result := FALSE;
          exit;
        end;
      end;
   end;

end;

{----------------------------------}
function TMyArrayOfInt.Get(Indeks : longint) : integer;
var
   R, C : longint;
begin
   Result := -9999;
   if (Indeks < 0) then exit;
   if (Indeks > ArrSize-1) then exit;
   R := Indeks div 16000;      { which row? }
   C := Indeks - (R*16000);
   Result := ArrData^[R]^[C];
end;

{----------------------------------}
procedure TMyArrayOfInt.Put(Indeks : longint; Value : integer);
var
   R, C : longint;
begin
   if (Indeks < 0) then exit;
   if (Indeks > ArrSize-1) then exit;
   R := Indeks div 16000;      { which row? }
   C := Indeks - (R*16000);
   ArrData^[R]^[C] := Value;
end;

{----------------------------------}
function TMyArrayOfInt.MaxSize : longint;
begin
   Result := ArrSize;
end;

{----------------------------------}
procedure TMyArrayOfInt.Fill(FillValue : integer);
var
   I : longint;
begin
   for I:=0 to ArrSize-1 do Put(I, FillValue);
end;


{--------------------------------------------------------------------------}
{----------------------------------}
constructor TMyArrayOfLongInt.Create;
begin
   ArrSize := 0;
end;

{----------------------------------}
destructor TMyArrayOfLongInt.Destroy;
begin
   SetSize(0);
   inherited Destroy;
end;

{----------------------------------}
function TMyArrayOfLongInt.SetSize(NumEntries : longint) : boolean;
var
  I, J, Rows : longint;
begin
   Result := TRUE;

   { clear any existing data in the array(s) }
   if (ArrSize > 0) then begin
     Rows := ((ArrSize-1) div 16000) + 1;
     for I:=Rows-1 downto 0 do begin
        J := 16000;
        if (I = 0) then J := ArrSize - (Rows-1)*16000;
        try
           FreeMem(ArrData^[I], J*sizeof(longint));
        except
            ;   { dummy statement just to clear error condition }
        end;
     end;
        try
           FreeMem(ArrData, Rows * sizeof(PArrayOfLongInt));
        except
            ;   { dummy statement just to clear error condition }
        end;
     ArrSize := 0;
   end;

   { if new size is zero then return TRUE }
   if (NumEntries = 0) then exit;

   { if new size is too large then return FALSE }
   if (NumEntries > 16000*16000) then begin
      Result := FALSE;
      exit;
   end;

   { allocate new memory }
   ArrSize := NumEntries;
   Rows := ((ArrSize-1) div 16000) + 1;
   try
     GetMem(ArrData, Rows*sizeof(PArrayOfLongInt));
   except
     on EOutOfMemory do begin
       MessageDlg('Out Of Memory Error', mtError, [mbOk], 0);
       Result := FALSE;
       exit;
     end;
     else begin
       MessageDlg('Unknown error while allocating memory', mtError, [mbOk], 0);
       Result := FALSE;
       exit;
     end;
   end;
   for I:=0 to Rows-1 do begin
      J := 16000;
      if (I = (Rows-1)) then J := ArrSize - (Rows-1)*16000;
      try
        GetMem(ArrData^[I], J*sizeof(longint));
      except
        on EOutOfMemory do begin
          for J := I-1 downto 0 do FreeMem(ArrData^[J], 16000*sizeof(longint));
          MessageDlg('Out Of Memory Error', mtError, [mbOk], 0);
          Result := FALSE;
          exit;
        end;
        else begin
          for J := I-1 downto 0 do FreeMem(ArrData^[J], 16000*sizeof(longint));
          MessageDlg('Unknown error while allocating memory', mtError, [mbOk], 0);
          Result := FALSE;
          exit;
        end;
      end;
   end;

end;

{----------------------------------}
function TMyArrayOfLongInt.Get(Indeks : longint) : longint;
var
   R, C : longint;
begin
   Result := -9999;
   if (Indeks < 0) then exit;
   if (Indeks > ArrSize-1) then exit;
   R := Indeks div 16000;      { which row? }
   C := Indeks - (R*16000);
   Result := ArrData^[R]^[C];
end;

{----------------------------------}
procedure TMyArrayOfLongInt.Put(Indeks : longint; Value : longint);
var
   R, C : longint;
begin
   if (Indeks < 0) then exit;
   if (Indeks > ArrSize-1) then exit;
   R := Indeks div 16000;      { which row? }
   C := Indeks - (R*16000);
   ArrData^[R]^[C] := Value;
end;

{----------------------------------}
function TMyArrayOfLongInt.GetSize : longint;
begin
   Result := ArrSize;
end;

{----------------------------------}
function TMyArrayOfLongInt.MaxSize : longint;
begin
   Result := ArrSize;
end;

{----------------------------------}
procedure TMyArrayOfLongInt.Fill(FillValue : longint);
var
   I : longint;
begin
   for I:=0 to ArrSize-1 do Put(I, FillValue);
end;


END.
