jcllogic.pas

East make Tray Icon in delphi

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

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

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


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

function BitsHighest(X: Int64): Integer;
begin
  if TULargeInteger(X).HighPart = 0 then
  begin
    if TULargeInteger(X).LowPart = 0 then
      Result := -1
    else
      Result := BitsHighest(TULargeInteger(X).LowPart);
  end
  else
    Result := BitsHighest(TULargeInteger(X).HighPart) + 32;
end;

function BitsLowest(X: Cardinal): Integer; assembler;
asm
        MOV     ECX, EAX
        MOV     EAX, -1
        BSF     EAX, ECX
end;

function BitsLowest(X: Byte): Integer;
begin
  Result := BitsLowest(Cardinal(X) and ByteMask);
end;

function BitsLowest(X: Shortint): Integer;
begin
  Result := BitsLowest(Cardinal(X) and ShortintMask);
end;

function BitsLowest(X: Smallint): Integer;
begin
  Result := BitsLowest(Cardinal(X) and SmallintMask);
end;

function BitsLowest(X: Word): Integer;
begin
  Result := BitsLowest(Cardinal(X) and WordMask);
end;

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

function BitsLowest(X: Int64): Integer;
begin
  if TULargeInteger(X).LowPart = 0 then
  begin
    if TULargeInteger(X).HighPart = 0 then
      Result := -1
    else
      Result := BitsLowest(TULargeInteger(X).HighPart) + 32;
  end
  else
    Result := BitsLowest(TULargeInteger(X).LowPart);
end;

function ClearBit(const Value: Byte; const Bit: TBitRange): Byte;
begin
  Result := Value and not (1 shl (Bit mod BitsPerByte));
end;

function ClearBit(const Value: Shortint; const Bit: TBitRange): Shortint;
begin
  Result := Value and not (1 shl (Bit mod BitsPerShortint));
end;

function ClearBit(const Value: Smallint; const Bit: TBitRange): Smallint;
begin
  Result := Value and not (1 shl (Bit mod BitsPerSmallint));
end;

function ClearBit(const Value: Word; const Bit: TBitRange): Word;
begin
  Result := Value and not (1 shl (Bit mod BitsPerWord));
end;

function ClearBit(const Value: Cardinal; const Bit: TBitRange): Cardinal;
begin
  Result := Value and not (1 shl (Bit mod BitsPerCardinal));
end;

function ClearBit(const Value: Integer; const Bit: TBitRange): Integer;
begin
  Result := Value and not (1 shl (Bit mod BitsPerInteger));
end;

function ClearBit(const Value: Int64; const Bit: TBitRange): Int64;
begin
  Result := Value and not (Int64(1) shl (Bit mod BitsPerInt64));
end;

procedure ClearBitBuffer(var Value; const Bit: TBitRange);
var
  P: PByte;
  BitOfs: TBitRange;
begin
  P := Addr(Value);
  Inc(P, Bit div 8);
  BitOfs := Bit mod 8;
  P^ := ClearBit(P^, BitOfs);
end;

function CountBitsSet(X: Cardinal): Integer;
var
  Index: Integer;
begin
  Result := 0;
  for Index := 1 to BitsPerCardinal do
  begin
    if (X and 1) = 1 then
      Inc(Result);
    X := X shr 1;
  end;
end;

function CountBitsSet(X: Byte): Integer;
var
  Index: Integer;
begin
  Result := 0;
  for Index := 1 to BitsPerByte do
  begin
    if (X and 1) = 1 then
      Inc(Result);
    X := X shr 1;
  end;
end;

function CountBitsSet(X: Word): Integer;
var
  Index: Integer;
begin
  Result := 0;
  for Index := 1 to BitsPerWord do
  begin
    if (X and 1) = 1 then
      Inc(Result);
    X := X shr 1;
  end;
end;

function CountBitsSet(X: Smallint): Integer;
begin
  Result := CountBitsSet(Word(X));
end;

function CountBitsSet(X: ShortInt): Integer;
begin
  Result := CountBitsSet(Byte(X));
end;

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

function CountBitsSet(P: Pointer; Count: Cardinal): Cardinal;
const
  lu : packed array[0..15] of Byte = (0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4);
var
  b: Byte;
begin
  Result := 0;
  while Count > 0 do
  begin
    b := PByte(P)^;
    // lower Nibble
    Inc(Result, lu[b and $0F]);
    // upper Nibble
    Inc(Result, lu[b shr 4]);

    Dec(Count);
    Inc(PByte(P));
  end;
end;

function CountBitsSet(X: Int64): Integer;
begin
  Result := CountBitsSet(TULargeInteger(X).LowPart) + CountBitsSet(TULargeInteger(X).HighPart);
end;

function CountBitsCleared(X: Byte): Integer;
begin
  Result := BitsPerByte - CountBitsSet(Byte(X));
end;

function CountBitsCleared(X: Shortint): Integer;
begin
  Result := BitsPerShortint - CountBitsSet(Byte(X));
end;

function CountBitsCleared(X: Smallint): Integer;
begin
  Result := BitsPerSmallint - CountBitsSet(Word(X));
end;

function CountBitsCleared(X: Word): Integer;
begin
  Result := BitsPerWord - CountBitsSet(Word(X));
end;

function CountBitsCleared(X: Integer): Integer;
begin
  Result := BitsPerInteger - CountBitsSet(Integer(X));
end;

function CountBitsCleared(X: Cardinal): Integer;
begin
  Result := BitsPerCardinal - CountBitsSet(Cardinal(X));
end;

function CountBitsCleared(X: Int64): Integer;
begin
  Result := BitsPerInt64 - CountBitsSet(Int64(X));
end;

function LRot(const Value: Byte; const Count: TBitRange): Byte; assembler;
asm
  MOV CL, Count
  ROL AL, CL
end;

function LRot(const Value: Word; const Count: TBitRange): Word; assembler;
asm
   MOV     CL, Count
   ROL     AX, CL
end;

function LRot(const Value: Integer; const Count: TBitRange): Integer; assembler;
asm
  MOV     CL, Count
  ROL     EAX, CL
end;

const
  // Lookup table of bit reversed nibbles, used by simple overloads of ReverseBits
  RevNibbles: array [0..NibbleMask] of Byte =
    ($0, $8, $4, $C, $2, $A, $6, $E, $1, $9, $5, $D, $3, $B, $7, $F);

function ReverseBits(Value: Byte): Byte;
begin
  Result := RevNibbles[Value shr BitsPerNibble] or
    (RevNibbles[Value and NibbleMask] shl BitsPerNibble);
end;

function ReverseBits(Value: Shortint): Shortint;
begin
  Result := RevNibbles[Byte(Value) shr BitsPerNibble] or
    (RevNibbles[Value and NibbleMask] shl BitsPerNibble);
end;

function ReverseBits(Value: Smallint): Smallint;
begin
  Result := ReverseBits(Word(Value));
end;

function ReverseBits(Value: Word): Word;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to NibblesPerWord - 1 do
  begin
    Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask];
    Value := Value shr BitsPerNibble;
  end;
end;

function ReverseBits(Value: Integer): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to NibblesPerInteger - 1 do
  begin
    Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask];
    Value := Value shr BitsPerNibble;
  end;
end;

function ReverseBits(Value: Cardinal): Cardinal;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to NibblesPerCardinal - 1 do
  begin
    Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask];
    Value := Value shr BitsPerNibble;
  end;
end;

function ReverseBits(Value: Int64): Int64;
begin
  TULargeInteger(Result).LowPart := ReverseBits(TULargeInteger(Value).HighPart);
  TULargeInteger(Result).HighPart := ReverseBits(TULargeInteger(Value).LowPart);
end;

const
  // Lookup table of reversed bytes, used by pointer overload of ReverseBits
  ReverseTable: array [0..ByteMask] of Byte = (
    $00, $80, $40, $C0, $20, $A0, $60, $E0,
    $10, $90, $50, $D0, $30, $B0, $70, $F0,
    $08, $88, $48, $C8, $28, $A8, $68, $E8,
    $18, $98, $58, $D8, $38, $B8, $78, $F8,
    $04, $84, $44, $C4, $24, $A4, $64, $E4,
    $14, $94, $54, $D4, $34, $B4, $74, $F4,
    $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC,
    $1C, $9C, $5C, $DC, $3C, $BC, $7C, $FC,
    $02, $82, $42, $C2, $22, $A2, $62, $E2,
    $12, $92, $52, $D2, $32, $B2, $72, $F2,
    $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA,
    $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA,
    $06, $86, $46, $C6, $26, $A6, $66, $E6,
    $16, $96, $56, $D6, $36, $B6, $76, $F6,
    $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE,
    $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE,
    $01, $81, $41, $C1, $21, $A1, $61, $E1,
    $11, $91, $51, $D1, $31, $B1, $71, $F1,
    $09, $89, $49, $C9, $29, $A9, $69, $E9,
    $19, $99, $59, $D9, $39, $B9, $79, $F9,
    $05, $85, $45, $C5, $25, $A5, $65, $E5,
    $15, $95, $55, $D5, $35, $B5, $75, $F5,
    $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED,
    $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD,
    $03, $83, $43, $C3, $23, $A3, $63, $E3,
    $13, $93, $53, $D3, $33, $B3, $73, $F3,
    $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB,
    $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB,
    $07, $87, $47, $C7, $27, $A7, $67, $E7,
    $17, $97, $57, $D7, $37, $B7, $77, $F7,
    $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF,
    $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF);

function ReverseBits(P: Pointer; Count: Integer): Pointer;
var
  P1, P2: PByte;
  T: Byte;
begin
  if (P <> nil) and (Count > 0) then
  begin
    P1 := P;
    P2 := PByte(Integer(P) + Count - 1);
    while Integer(P1) < Integer(P2) do
    begin
      T := ReverseTable[P1^];
      P1^ := ReverseTable[P2^];
      P2^ := T;
      Inc(P1);
      Dec(P2);
    end;
    if P1 = P2 then
      P1^ := ReverseTable[P1^];
  end;
  Result := P;
end;

function RRot(const Value: Byte; const Count: TBitRange): Byte; assembler;
asm
        MOV     CL, Count
        MOV     AL, Value
        ROR     AL, CL
        MOV     Result, AL
end;

function RRot(const Value: Word; const Count: TBitRange): Word; assembler;
asm
        MOV     CL, Count
        MOV     AX, Value
        ROR     AX, CL
        MOV     Result, AX
end;

function RRot(const Value: Integer; const Count: TBitRange): Integer; assembler;
asm
        MOV     CL, Count
        MOV     EAX, Value
        ROR     EAX, CL
        MOV     Result, EAX
end;

function Sar(const Value: Shortint; const Count: TBitRange): Shortint; assembler;
asm
        MOV     CL, DL
        SAR     AL, CL
end;

function Sar(const Value: Smallint; const Count: TBitRange): Smallint; assembler;
asm