jcllogic.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclLogic.pas.                                                               }
{                                                                                                  }
{ The Initial Developer of the Original Code is Marcel van Brakel.                                 }
{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved.  }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{   Marcel Bestebroer (marcelb)                                                                    }
{   Marcel van Brakel                                                                              }
{   ESB Consultancy                                                                                }
{   Martin Kimmings                                                                                }
{   Robert Marquardt (marquardt)                                                                   }
{   Chris Morris                                                                                   }
{   Andreas Schmidt shmia at bizerba.de                                                            }
{   Michael Schnell                                                                                }
{   Matthias Thoma (mthoma)                                                                        }
{   Petr Vones (pvones)                                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Various routines to perform various arithmetic and logical operations on one or more ordinal     }
{ values (integer numbers). This includes various bit manipulation routines, min/max testing and   }
{ conversion to string.                                                                            }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/02/24 16:34:40 $
// For history see end of file

{.$DEFINE PUREPASCAL}

unit JclLogic;

{$I jcl.inc}
{$RANGECHECKS OFF}

interface

// Conversion
function OrdToBinary(const Value: Byte): string; overload;
function OrdToBinary(const Value: ShortInt): string; overload;
function OrdToBinary(const Value: SmallInt): string; overload;
function OrdToBinary(const Value: Word): string; overload;
function OrdToBinary(const Value: Integer): string; overload;
function OrdToBinary(const Value: Cardinal): string; overload;
function OrdToBinary(const Value: Int64): string; overload;

// Bit manipulation
type
  TBitRange = Byte;
  TBooleanArray = array of Boolean;

function BitsHighest(X: Byte): Integer; overload;
function BitsHighest(X: ShortInt): Integer; overload;
function BitsHighest(X: SmallInt): Integer; overload;
function BitsHighest(X: Word): Integer; overload;
function BitsHighest(X: Integer): Integer; overload;
function BitsHighest(X: Cardinal): Integer; overload;
function BitsHighest(X: Int64): Integer; overload;

function BitsLowest(X: Byte): Integer; overload;
function BitsLowest(X: Shortint): Integer; overload;
function BitsLowest(X: Smallint): Integer; overload;
function BitsLowest(X: Word): Integer; overload;
function BitsLowest(X: Cardinal): Integer; overload;
function BitsLowest(X: Integer): Integer; overload;
function BitsLowest(X: Int64): Integer; overload;

function ClearBit(const Value: Byte; const Bit: TBitRange): Byte; overload;
function ClearBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload;
function ClearBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload;
function ClearBit(const Value: Word; const Bit: TBitRange): Word; overload;
function ClearBit(const Value: Integer; const Bit: TBitRange): Integer; overload;
function ClearBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload;
function ClearBit(const Value: Int64; const Bit: TBitRange): Int64; overload;
procedure ClearBitBuffer(var Value; const Bit: TBitRange);

function CountBitsSet(X: Byte): Integer; overload;
function CountBitsSet(X: Word): Integer; overload;
function CountBitsSet(X: Smallint): Integer; overload;
function CountBitsSet(X: ShortInt): Integer; overload;
function CountBitsSet(X: Integer): Integer; overload;
function CountBitsSet(X: Cardinal): Integer; overload;
function CountBitsSet(X: Int64): Integer; overload;
function CountBitsSet(P: Pointer; Count: Cardinal): Cardinal; overload;

function CountBitsCleared(X: Byte): Integer; overload;
function CountBitsCleared(X: Shortint): Integer; overload;
function CountBitsCleared(X: Smallint): Integer; overload;
function CountBitsCleared(X: Word): Integer; overload;
function CountBitsCleared(X: Integer): Integer; overload;
function CountBitsCleared(X: Cardinal): Integer; overload;
function CountBitsCleared(X: Int64): Integer; overload;

function LRot(const Value: Byte; const Count: TBitRange): Byte; overload;
function LRot(const Value: Word; const Count: TBitRange): Word; overload;
function LRot(const Value: Integer; const Count: TBitRange): Integer; overload;
function ReverseBits(Value: Byte): Byte; overload;
function ReverseBits(Value: Shortint): Shortint; overload;
function ReverseBits(Value: Smallint): Smallint; overload;
function ReverseBits(Value: Word): Word; overload;
function ReverseBits(Value: Integer): Integer; overload;
function ReverseBits(Value: Cardinal): Cardinal; overload;
function ReverseBits(Value: Int64): Int64; overload;
function ReverseBits(P: Pointer; Count: Integer): Pointer; overload;

function RRot(const Value: Byte; const Count: TBitRange): Byte; overload;
function RRot(const Value: Word; const Count: TBitRange): Word; overload;
function RRot(const Value: Integer; const Count: TBitRange): Integer; overload;

function Sar(const Value: Shortint; const Count: TBitRange): Shortint; overload;
function Sar(const Value: Smallint; const Count: TBitRange): Smallint; overload;
function Sar(const Value: Integer; const Count: TBitRange): Integer; overload;

function SetBit(const Value: Byte; const Bit: TBitRange): Byte; overload;
function SetBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload;
function SetBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload;
function SetBit(const Value: Word; const Bit: TBitRange): Word; overload;
function SetBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload;
function SetBit(const Value: Integer; const Bit: TBitRange): Integer; overload;
function SetBit(const Value: Int64; const Bit: TBitRange): Int64; overload;
procedure SetBitBuffer(var Value; const Bit: TBitRange);

function TestBit(const Value: Byte; const Bit: TBitRange): Boolean; overload;
function TestBit(const Value: Shortint; const Bit: TBitRange): Boolean; overload;
function TestBit(const Value: Smallint; const Bit: TBitRange): Boolean; overload;
function TestBit(const Value: Word; const Bit: TBitRange): Boolean; overload;
function TestBit(const Value: Cardinal; const Bit: TBitRange): Boolean; overload;
function TestBit(const Value: Integer; const Bit: TBitRange): Boolean; overload;
function TestBit(const Value: Int64; const Bit: TBitRange): Boolean; overload;
function TestBitBuffer(const Value; const Bit: TBitRange): Boolean;

function TestBits(const Value, Mask: Byte): Boolean; overload;
function TestBits(const Value, Mask: Shortint): Boolean; overload;
function TestBits(const Value, Mask: Smallint): Boolean; overload;
function TestBits(const Value, Mask: Word): Boolean; overload;
function TestBits(const Value, Mask: Cardinal): Boolean; overload;
function TestBits(const Value, Mask: Integer): Boolean; overload;
function TestBits(const Value, Mask: Int64): Boolean; overload;

function ToggleBit(const Value: Byte; const Bit: TBitRange): Byte; overload;
function ToggleBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload;
function ToggleBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload;
function ToggleBit(const Value: Word; const Bit: TBitRange): Word; overload;
function ToggleBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload;
function ToggleBit(const Value: Integer; const Bit: TBitRange): Integer; overload;
function ToggleBit(const Value: Int64; const Bit: TBitRange): Int64; overload;
procedure ToggleBitBuffer(var Value; const Bit: TBitRange);

procedure BooleansToBits(var Dest: Byte; const B: TBooleanArray); overload;
procedure BooleansToBits(var Dest: Word; const B: TBooleanArray); overload;
procedure BooleansToBits(var Dest: Integer; const B: TBooleanArray); overload;
procedure BooleansToBits(var Dest: Int64; const B: TBooleanArray); overload;

procedure BitsToBooleans(const Bits: Byte; var B: TBooleanArray; AllBits: Boolean = False); overload;
procedure BitsToBooleans(const Bits: Word; var B: TBooleanArray; AllBits: Boolean = False); overload;
procedure BitsToBooleans(const Bits: Integer; var B: TBooleanArray; AllBits: Boolean = False); overload;
procedure BitsToBooleans(const Bits: Int64; var B: TBooleanArray; AllBits: Boolean = False); overload;

function BitsNeeded(const X: Byte): Integer; overload;
function BitsNeeded(const X: Word): Integer; overload;
function BitsNeeded(const X: Integer): Integer; overload;
function BitsNeeded(const X: Int64): Integer; overload;

function Digits(const X: Cardinal): Integer;

function ReverseBytes(Value: Word): Word; overload;
function ReverseBytes(Value: Smallint): Smallint; overload;
function ReverseBytes(Value: Integer): Integer; overload;
function ReverseBytes(Value: Cardinal): Cardinal; overload;
function ReverseBytes(Value: Int64): Int64; overload;
function ReverseBytes(P: Pointer; Count: Integer): Pointer; overload;

// Arithmetic
procedure SwapOrd(var I, J: Byte); overload;
procedure SwapOrd(var I, J: Shortint); overload;
procedure SwapOrd(var I, J: Smallint); overload;
procedure SwapOrd(var I, J: Word); overload;
procedure SwapOrd(var I, J: Integer); overload;
procedure SwapOrd(var I, J: Cardinal); overload;
procedure SwapOrd(var I, J: Int64); overload;

function IncLimit(var B: Byte; const Limit: Byte; const Incr: Byte = 1): Byte; overload;
function IncLimit(var B: Shortint; const Limit: Shortint; const Incr: Shortint = 1): Shortint; overload;
function IncLimit(var B: Smallint; const Limit: Smallint; const Incr: Smallint = 1): Smallint; overload;
function IncLimit(var B: Word; const Limit: Word; const Incr: Word = 1): Word; overload;
function IncLimit(var B: Integer; const Limit: Integer; const Incr: Integer = 1): Integer; overload;
function IncLimit(var B: Cardinal; const Limit: Cardinal; const Incr: Cardinal = 1): Cardinal; overload;
function IncLimit(var B: Int64; const Limit: Int64; const Incr: Int64 = 1): Int64; overload;

function DecLimit(var B: Byte; const Limit: Byte; const Decr: Byte = 1): Byte; overload;
function DecLimit(var B: Shortint; const Limit: Shortint; const Decr: Shortint = 1): Shortint; overload;
function DecLimit(var B: Smallint; const Limit: Smallint; const Decr: Smallint = 1): Smallint; overload;
function DecLimit(var B: Word; const Limit: Word; const Decr: Word = 1): Word; overload;
function DecLimit(var B: Integer; const Limit: Integer; const Decr: Integer = 1): Integer; overload;
function DecLimit(var B: Cardinal; const Limit: Cardinal; const Decr: Cardinal = 1): Cardinal; overload;
function DecLimit(var B: Int64; const Limit: Int64; const Decr: Int64 = 1): Int64; overload;

function IncLimitClamp(var B: Byte; const Limit: Byte; const Incr: Byte = 1): Byte; overload;
function IncLimitClamp(var B: Shortint; const Limit: Shortint; const Incr: Shortint = 1): Shortint; overload;
function IncLimitClamp(var B: Smallint; const Limit: Smallint; const Incr: Smallint = 1): Smallint; overload;
function IncLimitClamp(var B: Word; const Limit: Word; const Incr: Word = 1): Word; overload;
function IncLimitClamp(var B: Integer; const Limit: Integer; const Incr: Integer = 1): Integer; overload;
function IncLimitClamp(var B: Cardinal; const Limit: Cardinal; const Incr: Cardinal = 1): Cardinal; overload;
function IncLimitClamp(var B: Int64; const Limit: Int64; const Incr: Int64 = 1): Int64; overload;

function DecLimitClamp(var B: Byte; const Limit: Byte; const Decr: Byte = 1): Byte; overload;
function DecLimitClamp(var B: Shortint; const Limit: Shortint; const Decr: Shortint = 1): Shortint; overload;
function DecLimitClamp(var B: Smallint; const Limit: Smallint; const Decr: Smallint = 1): Smallint; overload;
function DecLimitClamp(var B: Word; const Limit: Word; const Decr: Word = 1): Word; overload;
function DecLimitClamp(var B: Integer; const Limit: Integer; const Decr: Integer = 1): Integer; overload;
function DecLimitClamp(var B: Cardinal; const Limit: Cardinal; const Decr: Cardinal = 1): Cardinal; overload;
function DecLimitClamp(var B: Int64; const Limit: Int64; const Decr: Int64 = 1): Int64; overload;

function Max(const B1, B2: Byte): Byte; overload;
function Max(const B1, B2: Shortint): Shortint; overload;
function Max(const B1, B2: Smallint): Smallint; overload;
function Max(const B1, B2: Word): Word; overload;
function Max(const B1, B2: Integer): Integer; overload;
function Max(const B1, B2: Cardinal): Cardinal; overload;
function Max(const B1, B2: Int64): Int64; overload;

function Min(const B1, B2: Byte): Byte; overload;
function Min(const B1, B2: Shortint): Shortint; overload;
function Min(const B1, B2: Smallint): Smallint; overload;
function Min(const B1, B2: Word): Word; overload;
function Min(const B1, B2: Integer): Integer; overload;
function Min(const B1, B2: Cardinal): Cardinal; overload;
function Min(const B1, B2: Int64): Int64; overload;

implementation
uses
  JclBase;

type
  PByte = ^Byte;

const
  // Constants defining the number of bits in each Integer type

  BitsPerNibble   = 4;
  BitsPerByte     = 8;
  BitsPerShortint = SizeOf(Shortint) * BitsPerByte;
  BitsPerSmallint = SizeOf(Smallint) * BitsPerByte;
  BitsPerWord     = SizeOf(Word) * BitsPerByte;
  BitsPerInteger  = SizeOf(Integer) * BitsPerByte;
  BitsPerCardinal = SizeOf(Cardinal) * BitsPerByte;
  BitsPerInt64    = SizeOf(Int64) * BitsPerByte;

  // Constants defining the number of nibbles in each Integer type

  NibblesPerByte     = BitsPerByte div BitsPerNibble;
  NibblesPerShortint = SizeOf(Shortint) * NibblesPerByte;
  NibblesPerSmallint = SizeOf(Smallint) * NibblesPerByte;
  NibblesPerWord     = SizeOf(Word) * NibblesPerByte;
  NibblesPerInteger  = SizeOf(Integer) * NibblesPerByte;
  NibblesPerCardinal = SizeOf(Cardinal) * NibblesPerByte;
  NibblesPerInt64    = SizeOf(Int64) * NibblesPerByte;

  // Constants defining a mask with all bits set for each Integer type

  NibbleMask      = $F;
  ByteMask        = Byte($FF);
  ShortintMask    = Shortint($FF);
  SmallintMask    = Smallint($FFFF);
  WordMask        = Word($FFFF);
  IntegerMask     = Integer($FFFFFFFF);
  CardinalMask    = Cardinal($FFFFFFFF);
  Int64Mask       = Int64($FFFFFFFFFFFFFFFF);

// Conversion
function OrdToBinary(const Value: Byte): string;
var
  I: Integer;
  B: Byte;
  P: PChar;
begin
  SetLength(Result, BitsPerByte);
  P := PChar(Result) + ((BitsPerByte - 1) * SizeOf(Char));
  B := Value;
  for I := 0 to BitsPerByte - 1 do
  begin
    P^ := Chr(48 + (B and $00000001));
    Dec(P);
    B := B shr 1;
  end;
end;

function OrdToBinary(const Value: Shortint): string;
var
  I: Integer;
  S: Shortint;
  P: PChar;
begin
  SetLength(Result, BitsPerShortint);
  P := PChar(Result) + ((BitsPerShortint - 1) * SizeOf(Char));
  S := Value;
  for I := 0 to BitsPerShortint - 1 do
  begin
    P^ := Chr(48 + (S and $00000001));
    Dec(P);
    S := S shr 1;
  end;
end;

function OrdToBinary(const Value: Smallint): string;
var
  I: Integer;
  S: Smallint;
  P: PChar;
begin
  SetLength(Result, BitsPerSmallint);
  P := PChar(Result) + ((BitsPerSmallint - 1) * SizeOf(Char));
  S := Value;
  for I := 0 to BitsPerSmallint - 1 do
  begin
    P^ := Chr(48 + (S and $00000001));
    Dec(P);
    S := S shr 1;
  end;
end;

function OrdToBinary(const Value: Word): string;
var
  I: Integer;
  W: Word;
  P: PChar;
begin
  SetLength(Result, BitsPerWord);
  P := PChar(Result) + ((BitsPerWord - 1) * SizeOf(Char));
  W := Value;
  for I := 0 to BitsPerWord - 1 do
  begin
    P^ := Chr(48 + (W and $00000001));
    Dec(P);
    W := W shr 1;
  end;
end;

function OrdToBinary(const Value: Integer): string;
var
  I, J: Integer;
  P: PChar;
begin
  SetLength(Result, BitsPerInteger);
  P := PChar(Result) + ((BitsPerInteger - 1) * SizeOf(Char));
  J := Value;
  for I := 0 to BitsPerInteger - 1 do
  begin
    P^ := Chr(48 + (J and $00000001));
    Dec(P);
    J := J shr 1;
  end;
end;

function OrdToBinary(const Value: Cardinal): string;
var
  I: Integer;
  J: Cardinal;
  P: PChar;
begin
  SetLength(Result, BitsPerCardinal);
  P := PChar(Result) + ((BitsPerCardinal - 1) * SizeOf(Char));
  J := Value;
  for I := 0 to BitsPerCardinal - 1 do
  begin
    P^ := Chr(48 + (J and $00000001));
    Dec(P);
    J := J shr 1;
  end;
end;

function OrdToBinary(const Value: Int64): string;
var
  I: Integer;
  I64: Int64;
  P: PChar;
begin
  SetLength(Result, BitsPerInt64);
  P := PChar(Result) + ((BitsPerInt64 - 1) * SizeOf(Char));
  I64 := Value;
  for I := 0 to BitsPerInt64 - 1 do
  begin
    P^ := Chr(48 + (I64 and Int64(1)));
    Dec(P);
    I64 := I64 shr Int64(1);
  end;
end;


// Bit manipulation
function BitsHighest(X: Cardinal): Integer; assembler;
asm
        MOV     ECX, EAX
        MOV     EAX, -1
        BSR     EAX, ECX
end;

function BitsHighest(X: Integer): Integer;
begin
  Result := BitsHighest(Cardinal(X));
end;