dynarrb.pas

Delphi direct support for GIF files

  end;
  if N = 0
  then begin
    Mean := NoValue;
    Sd := NoValue;
  end
  else begin
    Mean := Sum / N;
    MeanOfSquares := SumOfSquares / N;
    if (MeanOfSquares - Sqr(Mean)) < 0  { should only be possible }
    then sd := 0                    {in case of rounding off errors }
    else sd := Sqrt( MeanOfSquares - Sqr(Mean) );
  end
end;  { TBigByteArray.GetMeanAndSigma }*)

function TBigByteArray.Max: Byte;
var maximum: Byte;
    i: Longint;
begin { TBigByteArray.Max }
   maximum := 0;
   for i := 1 to count
   do if Value[i] > maximum
      then maximum := Value[i];
   Max := maximum;
end;  { TBigByteArray.Max }

function TBigByteArray.Min: Byte;
var minimum, v: Byte;
    i: Longint;
begin { TBigByteArray.Min }
   minimum := 255;
   for i := 1 to count
   do begin
      v := Value[i];
      if v < minimum
      then minimum := v;
   end;
   Min := minimum;
end;  { TBigByteArray.Min }

(*procedure TBigByteArray.MultiplyWith(Factor: Single);
{ Multiplies all elements values with factor }
var i: Longint;
    v: Single;
begin { TBigByteArray.MultiplyWith }
   for i := 1 to Count
   do begin
      v := Value[i];
      if v <> NoValue
      then Value[i] := v * Factor;
   end;
end;  { TBigByteArray.MultiplyWith }*)

constructor TBigByteArray.ReadBinary(var F: File);
{ reads TBigByteArray from untyped file }
var
   size, result: longint;
   wresult: Integer;
begin { TBigByteArray.ReadBinary }
   BlockRead(F, FCount, SizeOf(FCount), wresult);
   Create(Count);
   size := Count * SizeOf(Byte);
{$ifdef ver80}
   BigBlockRead(F, FAddress^, size, result);
{$else}
   BlockRead(F, FAddress^, size, result);
{$endif ver80}
   if size <> result
   then Error('Error in TBigByteArray.ReadBinary: ' +
              'read number of bytes <> size');
end;  { TBigByteArray.ReadBinary }

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

(*
procedure TBigByteArray.SortAscending;
{ sorts the array ascending; may also be used for more than one-dimensional
dynamicarrays }

   PROCEDURE store_tree( root: nodepointer;
                         destination: TBigByteArray;
                         VAR currentindex: longint);
   BEGIN { store_tree }
      IF root <> Nil
      THEN BEGIN
         store_tree(root^.ltree, destination, currentindex);
         destination[currentindex] := root^.value;
         Inc(currentindex);
         store_tree(root^.rtree, destination, currentindex);
      END;
   END;  { store_tree }

VAR tree: avltreetype;
    i: longint;
    newvalue, treeval: nodepointer;
begin { TBigByteArray.SortAscending }
   tree.init;
   FOR i := 1 TO Count
   DO BEGIN
      tree.insert(Value[i]);
      {progressproc(0.8*i/nr_of_elements);}
      { Not up to 100% because tree.done requires some time too }
      { Tested: progressproc can take 50% of total time! }
   END;
   i := 1; { must be a var-parameter for store_tree }
   store_tree(tree.root, self, i);
   tree.done;
   {progressproc(1);}
end;  { TBigByteArray.SortAscending }
*)

procedure TBigByteArray.Subtract(other: TBigByteArray);
{ Subtracts the values of 'other' from the values of 'self' }
var i: Longint;
begin { TBigByteArray.Subtract }
   for i := 1 to Count
   do SetVal(i, Self[i] - other[i])
end;  { TBigByteArray.Subtract }

(*function TBigByteArray.Sum: Single;
{ Returns the sum of the values of the elements }
var i: Longint;
    s: Single;
begin { TBigByteArray.Sum }
   s := 0;
   for i := 1 to Count
   do if GetVal(i) <> NoValue
      then s := s + GetVal(i);
   Sum := s;
end;  { TBigByteArray.Sum }*)

procedure TBigByteArray.WriteBinary( var F: File );
{ writes TBigByteArray to untyped file }
var
   size, result: longint;
   wresult: Integer;
begin { TBigByteArray.WriteBinary }
   size := SizeOf(FCount);
   BlockWrite(F, FCount, size, wresult);
   size := Count * SizeOf(Byte);
{$ifdef ver80}
   BigBlockWrite(F, FAddress^, size, result);
{$else}
   BlockWrite(F, FAddress^, size, result);
{$endif ver80}
   if size <> result
   then Error('Error in TBigByteArray.WriteBinary: ' +
              'written number of bytes <> size');
end;  { TBigByteArray.WriteBinary }

(***** end of TBigByteArray *****)

constructor TByteArray2D.Create(N1, N2: Longint);
begin { TByteArray2D.Create }
  inherited Create;
  values := TBigByteArray.Create(N1*N2);
  FCount1 := N1;
  FCount2 := N2;
end;  { TByteArray2D.Create }

destructor TByteArray2D.Destroy;
begin { TByteArray2D.Destroy }
  Values.Free;
  FCount1 := 0;
  FCount2 := 0;
  inherited Destroy;
end;  { TByteArray2D.Destroy }

constructor TByteArray2D.Dim(N1, N2: Longint);
begin { TByteArray2D.Dim }
  inherited Create;
  values := TBigByteArray.Dim(N1*N2);
  FCount1 := N1;
  FCount2 := N2;
end;  { TByteArray2D.Dim }

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

procedure TByteArray2D.Clear;
{ Assigns zero to all elements }
begin { TByteArray2D.Clear }
   Values.Clear;
end;  { TByteArray2D.Clear }

function TByteArray2D.Copy: TByteArray2D;
begin { TByteArray2D.Copy }
   Result := TByteArray2D.Create(Count1, Count2);
{$ifdef ver80}
   BigMove(Values.FAddress, Result.Values.FAddress, Values.Count * SizeOf(Byte));
{$else}
   Move(Values.FAddress^, Result.Values.FAddress^, Values.Count * SizeOf(Byte));
{$endif ver80}
end;  { TByteArray2D.Copy }

function TByteArray2D.CopyRow(RowNo: Longint): TBigByteArray;
var
  FSource: Pointer;
begin { TByteArray2D.CopyRow }
  Result := TBigByteArray.Create(Count1);
  FSource := Values.FAddress;
  AddToAddress(FSource, ((RowNo-1)*Count1)*SizeOf(Byte) );
{$ifdef ver80}
  BigMove(FSource, Result.FAddress, Count1*SizeOf(Byte));
{$else}
  Move(FSource^, Result.FAddress^, Count1*SizeOf(Byte));
{$endif ver80}
end;  { TByteArray2D.CopyRow }

function TByteArray2D.GetTotalCount: Longint;
begin
   Result := Values.Count;
end;

function TByteArray2D.GetVal(i1, i2: Longint): Byte;
begin
   Result := Values[i1+(i2-1)*Count1];
end;

procedure TByteArray2D.SetVal(i1, i2: Longint; value: Byte);
begin
   Values[i1+(i2-1)*Count1] := Value;
end;

procedure TByteArray2D.FindMax(var i1, i2: Longint; var max: Byte);
var i: Longint;
begin
   Values.FindMax(i, max);
   i1 := (i-1) mod Count1 + 1;
   i2 := (i-1) div Count1 + 1;
end;

procedure TByteArray2D.FindMinMax(var min, max: Byte);
begin
   Values.FindMinMax(min, max);
end;

function TByteArray2D.Max: Byte;
begin
   Result := Values.Max;
end;

function TByteArray2D.Min: Byte;
begin
   Result := Values.Min;
end;

procedure TByteArray2D.MirrorX;
{ Inverses order of elements in y-direction }
var SelfCopy: TByteArray2D;
    ix, iy: longint;
begin { TByteArray2D.MirrorX }
   SelfCopy := Self.Copy;
   Self.Free;
   Create(SelfCopy.Count1, SelfCopy.Count2);
   for ix := 1 to Count1
   do for iy := 1 to Count2
      do Self[ix, iy] := SelfCopy[Count1-ix+1, iy];
   SelfCopy.Free;
end;  { TByteArray2D.MirrorX }

procedure TByteArray2D.MirrorY;
{ Inverses order of elements in x-direction }
var SelfCopy: TByteArray2D;
    ix, iy: longint;
begin { TByteArray2D.MirrorY }
   SelfCopy := Self.Copy;
   Self.Free;
   Create(SelfCopy.Count1, SelfCopy.Count2);
   for ix := 1 to Count1
   do for iy := 1 to Count2
      do Self[ix, iy] := SelfCopy[ix, Count2-iy+1];
   SelfCopy.Free;
end;  { TByteArray2D.MirrorY }

(*procedure TByteArray2D.MultiplyWith( Factor: Single);
begin { TByteArray2D.MultiplyWith }
   Values.MultiplyWith( Factor);
end; { TByteArray2D.MultiplyWith }*)

constructor TByteArray2D.ReadBinary( var F: File );
{ reads TByteArray2D from untyped fyle }
var
   size, result: longint;
   wresult: Integer;
begin { TByteArray2D.ReadBinary }
   BlockRead( F, FCount1, SizeOf(FCount1), wresult );
   BlockRead( F, FCount2, SizeOf(FCount2), wresult );
   Create( Count1, Count2);
   size := TotalCount * SizeOf( Byte);
{$ifdef ver80}
   BigBlockRead(F, Values.FAddress^, size, result);
{$else}
   BlockRead(F, Values.FAddress^, size, result);
{$endif}
   if size <> result
   then Error('Error in TByteArray2D.ReadBinary: ' +
              'read number of bytes <> size');
end;  { TByteArray2D.ReadBinary }

procedure TByteArray2D.SetRow(ColNo: Integer; RowValues: TBigByteArray);
var
  RowSize: Longint;
  InsertAddress: Pointer;
begin { TByteArray2D.SetRow }
  if (ColNo < 1) or (ColNo > Count2)
  then raise EIndexOutOfBounds.Create('Dynamic array index out of bounds');
  if RowValues.Count <> Count1
  then Error('Row doesn''t have equal number of elements as Matrix row');
  RowSize := Count1*SizeOf(Byte);
  InsertAddress := Values.FAddress;
  AddToAddress(InsertAddress, (ColNo-1)*RowSize);
  Move(RowValues.FAddress^, InsertAddress^, RowSize);
end;  { TByteArray2D.SetRow }

(*function TByteArray2D.Sum: Byte;
begin
end;*)

function TByteArray2D.SumColumns: TBigByteArray;
var sum: Byte;
    Row, Column: Longint;
begin { TByteArray2D.SumColumns }
  Result := TBigByteArray.Create(FCount1);
  for Row := 1 to FCount1
  do begin
    sum := 0;
    for Column := 1 to FCount2
    do begin
      sum := sum + Self[Row, Column];
    end;
    Result[Row] := sum;
  end;
end;  { TByteArray2D.SumColumns }

procedure TByteArray2D.Transpose;
{ Inverts rows and columns }
var SelfCopy: TByteArray2D;
    i1, i2: longint;
begin { TByteArray2D.Transpose }
   SelfCopy := Self.Copy;
   Self.Free;
   Create(SelfCopy.Count2, SelfCopy.Count1);
   for i1 := 1 to Count1
   do for i2 := 1 to Count2
      do Self[i1, i2] := SelfCopy[i2, i1];
   SelfCopy.Free;
end;  { TByteArray2D.Transpose }

procedure TByteArray2D.WriteBinary( var F: File );
{ writes TByteArray2D to untyped file }
var
   size, result: longint;
   wresult: Integer;
begin { TByteArray2D.WriteBinary }
   BlockWrite( F, FCount1, SizeOf(FCount1), wresult );
   BlockWrite( F, FCount2, SizeOf(FCount2), wresult );
   size := TotalCount * SizeOf( Byte);
{$ifdef ver80}
   BigBlockWrite( F, Values.FAddress^, size, result );
{$else}
   BlockWrite( F, Values.FAddress^, size, result );
{$endif}
   if size <> result
   then Error('Error in TByteArray2D.WriteBinary: ' +
              'written number of bytes <> size')
end;  { TByteArray2D.WriteBinary }

(***** end of TByteArray2D *****)

end. { UNIT DynArrB }