dynarrb.pas

Delphi direct support for GIF files

unit DynArrB;
{ Exports the TBigByteArray and TByteArray2D types.
The TBigByteArray type is a dynamic array type, with Bytes as
elements.
Indexing the elements is done exactly like a normal array;
the differences with a 'normal' array type are:
- one MUST call the constructor to create the array
- the size (no. of elements) of the array is determined at run time

R.P. Sterkenburg,
TNO Prins Maurits Laboratory, Rijswijk, The Netherlands

 6 May 96: - created (unit name DynArrS)
 7 May 96: - renamed property N to Count
           - added CopyInto method
13 May 96  - added Min & Max functions
14 May 96  - added inherited Create in constructor
           - added function FindMax and FindMinMax
12 Jul 96: - added function Average
23 Aug 96: - added procedure SortAscending
26 Aug 96: - added procedure MultiplyWith
 9 Sep 96: - added various new procedures analogous to old unit bigarrays
 7 Oct 96: - added TSingleArray.Subtract
           - corrected TSingleArray.Sum (check for NoValue added)
15 Nov 96: - replaced procedure CopyInto with function Copy
 4 Dec 96: - added TSingleArray2D.Copy
16 Dec 96: - added TSingleArray2D.EqualTo
18 Dec 96: - added TSingleArray.Append
12 Feb 97: - corrected bugs in the Copy methods
           - added calls to inherited Create and Destroy in TSingleArray2D
21 Feb 97: - created as modified version of unit DynArrS which
             exported the TSingleArray (+2D) type
           - deleted methods CreateLinear, Average, GetMeanAndSigma,
             MultiplyWith
 5 Mar 97: - added TByteArray2D.SetRow
           - made CopyRow a function
           - renamed TByteArray to TBigByteArray to prevent name conflicts
             with SysUtils' TBigByteArray
11 May 97: - made CopyRow more efficient by copying a block of bytes in
             stead of each element separately
14 Aug 97: - Deleted the System. scope-designator in SetRow, so that
             HeapUnit's Move procedure is called when necessary (again).
}

interface

type
   TBigByteArray = class(TObject)
   private
      FAddress: Pointer;
      FCount: Longint;
      function  GetVal(index: Longint): Byte;
      procedure SetVal(index: Longint; value: Byte);
   public
      constructor Create(N: Longint);
      constructor Dim(N: Longint);
      constructor ReadBinary(var F: File);
      destructor  Destroy; override;

      procedure Append(appendarray: TBigByteArray);
      procedure Clear;
      function  Copy: TBigByteArray;
      function  EqualTo(OtherArray: TBigByteArray): Boolean;
      procedure FillWith(Value: Byte);
      procedure FindMax(var i: Longint; var max: Byte);
      procedure FindMinMax(var min, max: Byte);
      {procedure GetMeanAndSigma(var Mean, sd: Single);}
      function  Max: Byte;
      function  Min: Byte;
      {procedure MultiplyWith(Factor: Single);}
      {procedure ReDim(NewSize: Longint);}
      {procedure SortAscending;}
      procedure Subtract(other: TBigByteArray);
      {function  Sum: Single;}
      procedure WriteBinary( var F: File );

      property Address: Pointer read FAddress;
      property Count: Longint read FCount;
      property Value[i: Longint]: Byte read GetVal write SetVal; default;
   end; { TBigByteArray }

   TByteArray2D = class(TObject)
   { Not TBigByteArray as ancestor because that would make it impossible
   to declare a new default array property. It also hides the Count property,
   so it is more difficult to mistakenly use it as a TBigByteArray }
   private
      Values: TBigByteArray;
      FCount1, FCount2: Longint;
      function  GetTotalCount: Longint;
      function  GetVal(i1, i2: Longint): Byte;
      procedure SetVal(i1, i2: Longint; value: Byte);
   public
      constructor Create(N1, N2: Longint);
      destructor  Destroy; override;
      constructor Dim(N1, N2: Longint);
      constructor ReadBinary(var F: File);

      procedure Clear;
      function  Copy: TByteArray2D;
      {procedure CopyRow(RowNo: Longint; var Row: TBigByteArray);}
      function  CopyRow(RowNo: Longint): TBigByteArray;
      procedure FindMax(var i1, i2: Longint; var max: Byte);
      procedure FindMinMax(var min, max: Byte);
      function  Max: Byte;
      function  Min: Byte;
      procedure MirrorX;
      procedure MirrorY;
      {procedure MultiplyWith( Factor: Single);}
      procedure SetRow(ColNo: Integer; RowValues: TBigByteArray);
      {function  Sum: Single;}
      function  SumColumns: TBigByteArray;
      procedure Transpose;
      procedure WriteBinary( var F: File );

      property TotalCount: Longint read GetTotalCount;
      property Count1: Longint read FCount1;
      property Count2: Longint read FCount2;
      property Value[i, j: Longint]: Byte read GetVal write SetVal; default;
   end; { TByteArray2D }

{const
   {MaxSingle: Single = 3.4E38;
   NoValue: Single = -1e20;}

procedure ReDim(var AnArray: TBigByteArray; NewSize: Longint);

implementation

uses
{$ifdef ver80}
   HeapUnit,       { Imports BigGetMem }
{$endif}
   MoreUtil,       { Imports CRLF }
   SysUtils;       { Imports IntToStr }

type
   EIndexOutOfBounds = class(Exception);
   ENotEnoughMemory = class(Exception);

procedure Error(msg: String);
begin
   raise Exception.Create(msg);
end;

procedure AddToAddress(var P: Pointer; Count: Longint);
begin { AddToAddress }
{$ifdef ver80}
  if Count > 64000
  then heapunit.AddToAddress(P, Count)
  else P := Pointer(Longint(P)+Count);
{$else}
  P := Pointer(Longint(P)+Count);
{$endif}
end;  { AddToAddress }

procedure ReDim(var AnArray: TBigByteArray; NewSize: Longint);
var Result: TBigByteArray;
    TotalSize: Longint;
begin { TBigByteArray.ReDim }
  TotalSize := AnArray.Count * SizeOf(Byte);
  Result := TBigByteArray.Create(NewSize);
  Move(AnArray.FAddress^, Result.FAddress^, TotalSize);
  AnArray.Free;
  AnArray := Result;
end;  { TBigByteArray.ReDim }

(***** methods of TBigByteArray *****)

constructor TBigByteArray.Create(N: Longint);
{ Creates one dimensional array }
var
   TotalSize: Longint;
   ErrorMessage: String;
begin { TBigByteArray.Create }
   inherited create;
   FCount := N;
   TotalSize := Longint(Count) * SizeOf(Byte);
{$ifdef ver80}
   BigGetMem(FAddress, TotalSize);
{$else}
   GetMem(FAddress, TotalSize);
{$endif}
   if (Address = nil) and (TotalSize <> 0)
   then begin
      ErrorMessage :=
        'error in TBigByteArray.create: '+
        'Not enough contiguous memory available' + CRLF +
        ' requested memory block: '+ IntToStr(TotalSize) +' bytes'{+ CRLF +
        ' largest memory block: '+ IntToStr(maxavail) +' bytes'+ CRLF +
        ' total free memory: '+ IntToStr(memavail) +' bytes'};
      raise ENotEnoughMemory.Create(ErrorMessage)
   end;
end;  { TBigByteArray.Create }

destructor TBigByteArray.Destroy;
{ Disposes array }
var
   TotalSize: Longint;
begin { TBigByteArray.Destroy }
   TotalSize := Count * SizeOf(Byte);
{$ifdef ver80}
   BigFreeMem(FAddress, TotalSize);
{$else}
   FreeMem(FAddress, TotalSize);
{$endif ver80}
   FCount := 0;
   inherited Destroy;
end;  { TBigByteArray.Destroy }

constructor TBigByteArray.Dim(N: Longint);
{ Creates one dimensional array, sets values to zero }
begin { TBigByteArray.Dim }
   Create(N);
   Clear;
end;  { TBigByteArray.Dim }

(***** end of constructors and destructors *****)

(***** field access methods *****)

function TBigByteArray.GetVal(index: Longint): Byte;
{ Gets value of array element }
var
   p: Pointer;
   value: Byte;
begin { TBigByteArray.GetVal }
   if (index < 1) or (index > Count)
   then raise EIndexOutOfBounds.Create('Dynamic array index out of bounds');
   p := Address;
   AddToAddress(p, (index-1) * SizeOf(Byte));
   Move(p^, value, SizeOf(Byte));
   GetVal := value;
end;  { TBigByteArray.GetVal }

procedure TBigByteArray.SetVal(index: Longint; value: Byte);
{ Sets value of array element }
var
   p: Pointer;
begin { TBigByteArray.SetVal }
   if (index < 1) or (index > Count)
   then raise EIndexOutOfBounds.Create('Dynamic array index out of bounds');
   p := FAddress;
   AddToAddress(p, (index-1) * SizeOf(Byte));
   Move(value, p^, SizeOf(Byte));
end;  { TBigByteArray.SetVal }

(***** end of the field access methods *****)

procedure TBigByteArray.Append(AppendArray: TBigByteArray);
{ Append AppendArray at the end of 'self'.
Note that the implementation can be a lot optimized for speed
by moving blocks of memory in stead of one element at a time }
var TempArray: TBigByteArray;
    i: Longint;
begin { TBigByteArray.Append }
   TempArray := Self.Copy;
   Self.Free;
   Create(Count + appendarray.Count);
   for i := 1 to Count
   do Self[i] := TempArray[i];
   for i := 1 to AppendArray.Count
   do Self[Count+i] := AppendArray[i];
   TempArray.Free;
end;  { TBigByteArray.Append }

(*function TBigByteArray.Average: Single;
var sum: Single;
    i, N: Longint;
begin { TBigByteArray.Average }
   sum := 0;
   N := 0;
   for i := 1 to count
   do begin
     if Value[i] <> NoValue
     then begin
       Inc(N);
       sum := sum + Value[i];
     end;
   end;
   if N <> 0
   then Average := sum / N
   else Average := NoValue
end;  { TBigByteArray.Average }*)

procedure TBigByteArray.Clear;
{ Assigns zero to all elements }
var
   TotalSize: Longint;
begin { TBigByteArray.Clear }
   TotalSize := Count * SizeOf(Byte);
{$ifdef ver80}
   BigFillChar(FAddress, TotalSize, chr(0));
{$else}
   FillChar(FAddress^, TotalSize, chr(0));
{$endif ver80}
end;  { TBigByteArray.Clear }

function TBigByteArray.Copy: TBigByteArray;
{ Creates a copy of the array }
begin { TBigByteArray.Copy }
   Result := TBigByteArray.Create(Count);
{$ifdef ver80}
   BigMove(FAddress, Result.FAddress, Count * SizeOf(Byte));
{$else}
   Move(FAddress^, Result.FAddress^, Count * SizeOf(Byte));
{$endif ver80}
end;  { TBigByteArray.Copy }

function TBigByteArray.EqualTo(OtherArray: TBigByteArray): Boolean;
var index: Longint;
begin { TBigByteArray.EqualTo }
  Result := True;
  if Count <> OtherArray.Count
  then Result := False
  else begin
    Index := 1;
    while (Result = True) and (index <= Count)
    do begin
      if GetVal(Index) <> OtherArray[Index]
      then Result := False
      else Inc(Index);
    end
  end;
end;  { TBigByteArray.EqualTo }

procedure TBigByteArray.FillWith(Value: Byte);
var i: Longint;
begin { TBigByteArray.FillWith }
   for i := 1 to Count
   do Self[i] := Value;
end;  { TBigByteArray.FillWith }

procedure TBigByteArray.FindMax(var i: Longint; var max: Byte);
var j: Longint;
    value: Byte;
begin { TBigByteArray.FindMax }
   max := 0;
   for j := 1 to Count
   do begin
      value := GetVal(j);
      if value > max
      then begin
         i := j;
         max := value;
      end;
   end;
end;  { TBigByteArray.FindMax }

procedure TBigByteArray.FindMinMax(var min, max: Byte);
var j: Longint;
    value: Byte;
begin { TBigByteArray.FindMinMax }
   min := 255;
   max := 0;
   for j := 1 to Count
   do begin
      value := GetVal(j);
      if value < min
      then min := value;
      if value > max
      then max := value;
   end;
end;  { TBigByteArray.FindMinMax }

(*procedure TBigByteArray.GetMeanAndSigma(var Mean, sd: Single);
{ calculates mean and standard deviation of elements }
var
  i, N: longint;
  value, Sum, SumOfSquares, MeanOfSquares: single;
begin { TBigByteArray.GetMeanAndSigma }
  SumOfSquares := 0;
  Sum := 0;
  N := 0;
  for i := 1 to Count
  do begin
    value := GetVal(i);
    if Value <> NoValue
    then begin
      Inc(N);
      Sum := Sum + value;
      SumOfSquares := SumOfSquares + sqr(value);
    end;