Chip 1998 March/Chip_1998-03_cd.bin/zkuste/delphi/WhiteAnts/PROGRESS.ZIP/NUMUTILS.PAS

Pascal/Delphi Source File | 1997-01-10 | 9.3 KB | 330 lines

{
+----------------------------------------------------------------------------+
|                                      ⌐  ⌐                                  |
|                                    ⌐⌐ ⌐ ⌐ ⌐                                |
|                                 ⌐⌐⌐ ⌐   ⌐  ⌐                               |
|                                 ⌐⌐    ⌐ ⌐   ⌐                              |
|                  ⌐             ⌐⌐     ⌐  ⌐                                 |
|                 ⌐ ⌐            ⌐⌐⌐    ⌐⌐  ⌐                                |
|             ⌐⌐  ⌐  ⌐      ⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐  ⌐                                    |
|            ⌐  ⌐⌐  ⌐⌐      ⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐                                  |
|            ⌐ ⌐⌐⌐ ⌐⌐⌐⌐⌐⌐ ⌐⌐⌐ ⌐   ⌐⌐⌐⌐⌐⌐⌐⌐                                   |
|           ⌐ ⌐⌐ ⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐ ⌐   ⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐      Copyright ⌐ 1996-1997 by:  |
|           ⌐ ⌐⌐⌐⌐⌐⌐ ⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐⌐  ⌐ ⌐⌐⌐⌐⌐ ⌐⌐                                 |
|          ⌐ ⌐⌐⌐⌐⌐⌐⌐   ⌐⌐⌐⌐⌐ ⌐⌐⌐⌐    ⌐⌐ ⌐⌐ ⌐      WHITE ANTS SYSTEMHOUSE BV  |
|         ⌐  ⌐⌐⌐⌐⌐⌐⌐ ⌐⌐⌐ ⌐⌐⌐ ⌐⌐ ⌐       ⌐⌐⌐⌐      Geleen 12                  |
|         ⌐ ⌐⌐⌐⌐⌐⌐⌐    ⌐   ⌐⌐   ⌐⌐⌐       ⌐       8032 GB Zwolle             |
|           ⌐⌐⌐⌐⌐⌐     ⌐            ⌐ ⌐           Netherlands                |
|      ⌐⌐⌐  ⌐⌐⌐⌐⌐      ⌐     ⌐⌐     ⌐  ⌐                                     |
|            ⌐⌐       ⌐              ⌐  ⌐⌐⌐ ⌐     Tel. [phone]      |
|      ⌐              ⌐              ⌐            Fax. [phone]      |
|      ⌐             ⌐               ⌐⌐                                      |
|    ⌐              ⌐                  ⌐⌐         www.whiteants.com          |
|  ⌐⌐              ⌐                     ⌐ ⌐      [e-mail]      |
|                 ⌐                                                          |
+----------------------------------------------------------------------------+
  file     : NumUtils
  version  : 1.0
  comment  : NumUtils contains numeric utility procedures
  author   : G. Beuze / J. Laarhoven / R. Post
  compiler : Delphi 1.0
+----------------------------------------------------------------------------+
| DISCLAIMER:                                                                |
| THIS SOURCE IS FREEWARE. YOU ARE ALLOWED TO USE IT IN YOUR OWN PROJECTS    |
| WITHOUT ANY RESTRICTIONS, BUT YOU ARE NOT ALLOWED TO SELL IT IN ANY WAY.   |
| THERE IS NO WARRANTY AT ALL - YOU USE IT ON YOUR OWN RISC. WHITE ANTS DOES |
| NOT ASSUME ANY RESPONSIBILITY FOR ANY DAMAGE OR ANY LOSS OF TIME OR MONEY  |
| DUE THE USE OF ANY PART OF THIS SOURCE CODE.                               |
+----------------------------------------------------------------------------+
}
unit NumUtils;

interface

{
******************** Ordinal type procedures and functions *******************
}
function MaxNInt(const Values: array of LongInt): LongInt;
  { returns minimum of n longints, Values must contain at least one item }

function MinNInt(const Values: array of LongInt): LongInt;
  { returns minimum of n LongInts, Values must contain at least one item }

function Min2Int(X, Y: Integer): Integer;
  { returns minimum from x, y }

function Max2Int(X, Y: Integer): Integer;
  { Returns maximum from x, y }

function MinLong(X, Y: LongInt): LongInt;
  { returns minimum from x, y }

function MaxLong(X, Y: LongInt): LongInt;
  { Returns maximum from x, y }

function MinWord(X, Y: Word): Word;
  { returns minimum from x, y }

function MaxWord(X, Y: Word): Word;
  { Returns maximum from x, y }

function MinByte(X, Y: Byte): Byte;
  { returns minimum from x, y }

function MaxByte(X, Y: Byte): Byte;
  { Returns maximum from x, y }

function CompareInt(L1, L2: LongInt): Integer;
  { Returns 1 if L1 > L2, -1 if L1 < l2 and 0 if L1 = L2 }

function InRange(Value, LowBound, UpBound: LongInt): Boolean;
  { Returns True if Value >= LowBound and Value <= UpBound }

function LimitToRange(Value, LowBound, UpBound: LongInt): LongInt;
  { Returns Value if Value in range [LowBound..UpBound] else Low or Up.
    If range is invalid (LowBound > UpBound) LowBound is returned }

procedure MirrorLong(var L: LongInt);
  { converts order of bytes: $01020304 => $04030201 }

function GetMirror(L: LongInt): LongInt;
  { returns MirrorLong(L) }

procedure SetBits(var State: Word; ABits: Word; Enable: Boolean);
  { Enables ABits bits in State }

function BitState(State, ABits: Word): Boolean;
  { Returns True if State and ABits  <> 0 , so if any bit is set }

{
***************************Floating point utility funtions ****************************
}
function MaxFloat(X, Y: Extended): Extended;
  { Returns maximum from x, y }

function MinFloat(X, Y: Extended): Extended;
  { Returns minimum from x, y }

function MaxNFloat(const Values: array of Extended): Extended;
  { Returns maximum of Values, Values must contain at least one item }

function MinNFloat(const Values: array of Extended): Extended;
  { Returns Minimum of Values, Values must contain at least one item }

procedure SwapFloat(var X, Y: Extended);
  { Swaps x with y and vice versa }

function Log2(X: Extended): Extended;
  { Returns the 2_Log(x) value }

function PWR(X, Y : Extended): Extended;
  { returns X^Y, calculated as PWR := Exp(Y * Ln(X)) for X > 0.
    X MUST be > 0 }

function Sign(X: Extended): LongInt;
  { Returns the sign of X: 1 if X >= 0 else -1 }

implementation

{
******************** Ordinal type procedures and functions *******************
}
function MaxNInt(const Values: array of LongInt): LongInt;
var I: Integer;
begin
  Result := Values[Low(Values)];
  for I := Low(Values) + 1 to High(Values) do
    if Values[I] > Result then Result := Values[I];
end;

function MinNInt(const Values: array of LongInt): LongInt;
var I: Integer;
begin
  Result := Values[Low(Values)];
  for I := Low(Values) + 1 to High(Values) do
    if Values[I] < Result then Result := Values[I];
end;

function Min2Int(X, Y: Integer): Integer; assembler;
asm
        MOV     AX,X
        CMP     AX,Y
        JLE     @@1
        MOV     AX,Y
@@1:
end;

function Max2Int(X, Y: Integer): Integer; assembler;
asm
        MOV     AX,X
        CMP     AX,Y
        JGE     @@1
        MOV     AX,Y
@@1:
end;

function MaxLong(X, Y: LongInt): LongInt;
begin
  if X >= Y then
    Result := X
  else
    Result := Y;
end;

function MinLong(X, Y: LongInt): LongInt;
begin
  if X <= Y then
    Result := X
  else
    Result := Y;
end;

function MinWord(X, Y: Word): Word; assembler;
asm
        MOV     AX,X
        CMP     AX,Y
        JBE     @@1
        MOV     AX,Y
@@1:
end;

function MaxWord(X, Y: Word): Word; assembler;
asm
        MOV     AX,X
        CMP     AX,Y
        JAE     @@1
        MOV     AX,Y
@@1:
end;

function MinByte(X, Y: Byte): Byte;
begin
  if X >= Y then
    Result := Y
  else
    Result := X;
end;

function MaxByte(X, Y: Byte): Byte;
begin
  if X <= Y then
    Result := Y
  else
    Result := X;
end;

function CompareInt(L1, L2: LongInt): Integer;
begin
  if L1 < L2 then Result := -1
  else
    if L1 > L2 then Result := 1
    else  Result := 0;
end;

function InRange(Value, LowBound, UpBound: LongInt): Boolean;
begin
  Result := (Value >= LowBound) and (Value <= UpBound);
end;

function LimitToRange(Value, LowBound, UpBound: LongInt): LongInt;
begin
  Result := MaxLong(LowBound, MinLong(UpBound, Value));
end;

procedure MirrorLong(var L: LongInt);
var
  Buf : record
    case Integer of
      0: (Long: LongInt);
      1: (B: array[0..3] of Byte);
    end;
  AByte: Byte;
begin
  Buf.Long := L;
  AByte := Buf.B[0];
  Buf.B[0] := Buf.B[3];
  Buf.B[3] := AByte;
  AByte := Buf.B[1];
  Buf.B[1] := Buf.B[2];
  Buf.B[2] := AByte;
  L := Buf.Long;
end;

function GetMirror(L: LongInt): LongInt;
begin
  MirrorLong(L);
  Result := L;
end;

procedure SetBits(var State: Word; ABits: Word; Enable: Boolean);
begin
  if Enable then
    State := State or ABits
  else
    State := State and not ABits;
end;

function BitState(State, ABits: Word): Boolean;
begin
  Result := (State and ABits <> 0);
end;


{
**************************** Floating point utility routines ****************************
}
function MaxFloat(X, Y: Extended): Extended;
begin
  if X >= Y then Result := X else Result := Y;
end;

function MinFloat(X, Y: Extended): Extended;
begin
  if X <= Y then Result := X else Result := Y;
end;

function MaxNFloat(const Values: array of Extended): Extended;
var I: Integer;
begin
  Result := Values[Low(Values)];
  for I := Low(Values) + 1 to High(Values) do
    if Values[I] > Result then Result := Values[I];
end;

function MinNFloat(const Values: array of Extended): Extended;
var I: Integer;
begin
  Result := Values[Low(Values)];
  for I := Low(Values) + 1 to High(Values) do
    if Values[I] < Result then Result := Values[I];
end;

procedure SwapFloat(var X, Y: Extended);
var Z: Extended;
begin
  Z := X;
  X := Y;
  Y := Z;
end;

function Log2(X: Extended): Extended;
const ln2 : Extended = 0.;
begin
  if ln2 = 0. then ln2 := Ln(2);
  Result := Ln(X)/ln2
end;

function PWR(X, Y : Extended): Extended;
begin
  PWR := Exp(Y * Ln(X))
end;

function Sign(X: Extended): LongInt;
begin
  if X < 0 then Result := -1 else Result := 1;
end;



end.