jcllogic.pas

East make Tray Icon in delphi

        MOV     CL, DL
        SAR     AX, CL
end;

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

function SetBit(const Value: Byte; const Bit: TBitRange): Byte;
begin
  Result := Value or (1 shl (Bit mod BitsPerByte));
end;

function SetBit(const Value: Shortint; const Bit: TBitRange): Shortint;
begin
  Result := Value or (1 shl (Bit mod BitsPerShortint));
end;

function SetBit(const Value: Smallint; const Bit: TBitRange): Smallint;
begin
  Result := Value or (1 shl (Bit mod BitsPerSmallint));
end;

function SetBit(const Value: Word; const Bit: TBitRange): Word;
begin
  Result := Value or (1 shl (Bit mod BitsPerWord));
end;

function SetBit(const Value: Cardinal; const Bit: TBitRange): Cardinal;
begin
  Result := Value or (1 shl (Bit mod BitsPerCardinal));
end;

function SetBit(const Value: Integer; const Bit: TBitRange): Integer;
begin
  Result := Value or (1 shl (Bit mod BitsPerInteger));
end;

function SetBit(const Value: Int64; const Bit: TBitRange): Int64;
begin
  Result := Value or (Int64(1) shl (Bit mod BitsPerInt64));
end;

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

function TestBit(const Value: Byte; const Bit: TBitRange): Boolean;
begin
  Result := (Value and (1 shl (Bit mod BitsPerByte))) <> 0;
end;

function TestBit(const Value: Shortint; const Bit: TBitRange): Boolean;
begin
  Result := (Value and (1 shl (Bit mod BitsPerShortint))) <> 0;
end;

function TestBit(const Value: Smallint; const Bit: TBitRange): Boolean;
begin
  Result := (Value and (1 shl (Bit mod BitsPerSmallint))) <> 0;
end;

function TestBit(const Value: Word; const Bit: TBitRange): Boolean;
begin
  Result := (Value and (1 shl (Bit mod BitsPerWord))) <> 0;
end;

function TestBit(const Value: Cardinal; const Bit: TBitRange): Boolean;
begin
  Result := (Value and (1 shl (Bit mod BitsPerCardinal))) <> 0;
end;

function TestBit(const Value: Integer; const Bit: TBitRange): Boolean;
begin
  Result := (Value and (1 shl (Bit mod BitsPerInteger))) <> 0;
end;

function TestBit(const Value: Int64; const Bit: TBitRange): Boolean;
begin
  Result := (Value and (Int64(1) shl (Bit mod BitsPerInt64))) <> 0;
end;

function TestBitBuffer(const Value; const Bit: TBitRange): Boolean;
var
  P: PByte;
  BitOfs: TBitRange;
begin
  P := Addr(Value);
  Inc(P, Bit div 8);
  BitOfs := Bit mod 8;
  Result := TestBit(P^, BitOfs);
end;

function TestBits(const Value, Mask: Byte): Boolean;
begin
  Result := (Value and Mask) = Mask;
end;

function TestBits(const Value, Mask: Shortint): Boolean;
begin
  Result := (Value and Mask) = Mask;
end;

function TestBits(const Value, Mask: Smallint): Boolean;
begin
  Result := (Value and Mask) = Mask;
end;

function TestBits(const Value, Mask: Word): Boolean;
begin
  Result := (Value and Mask) = Mask;
end;

function TestBits(const Value, Mask: Cardinal): Boolean;
begin
  Result := (Value and Mask) = Mask;
end;

function TestBits(const Value, Mask: Integer): Boolean;
begin
  Result := (Value and Mask) = Mask;
end;

function TestBits(const Value, Mask: Int64): Boolean;
begin
  Result := (Value and Mask) = Mask;
end;

function ToggleBit(const Value: Byte; const Bit: TBitRange): Byte;
begin
  Result := Value xor (1 shl (Bit mod BitsPerByte));
end;

function ToggleBit(const Value: Shortint; const Bit: TBitRange): Shortint;
begin
  Result := Value xor (1 shl (Bit mod BitsPerShortint));
end;

function ToggleBit(const Value: Smallint; const Bit: TBitRange): Smallint;
begin
  Result := Value xor (1 shl (Bit mod BitsPerSmallint));
end;

function ToggleBit(const Value: Word; const Bit: TBitRange): Word;
begin
  Result := Value xor (1 shl (Bit mod BitsPerWord));
end;

function ToggleBit(const Value: Cardinal; const Bit: TBitRange): Cardinal;
begin
  Result := Value xor (1 shl (Bit mod BitsPerCardinal));
end;

function ToggleBit(const Value: Integer; const Bit: TBitRange): Integer;
begin
  Result := Value xor (1 shl (Bit mod BitsPerInteger));
end;

function ToggleBit(const Value: Int64; const Bit: TBitRange): Int64;
begin
  Result := Value xor (Int64(1) shl (Bit mod BitsPerInt64));
end;

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

procedure BooleansToBits(var Dest: Byte; const B: TBooleanArray);
var
  I, H: Integer;
begin
  Dest := 0;
  H := Min(Byte(BitsPerByte - 1), High(B));
  for I := 0 to H do
    if B[I] then
      Dest := SetBit(Dest, TBitRange(I));
end;

procedure BooleansToBits(var Dest: Word; const B: TBooleanArray);
var
  I, H: Integer;
begin
  Dest := 0;
  H := Min(Word(BitsPerWord - 1), High(B));
  for I := 0 to H do
    if B[I] then
      Dest := SetBit(Dest, TBitRange(I));
end;

procedure BooleansToBits(var Dest: Integer; const B: TBooleanArray);
var
  I, H: Integer;
begin
  Dest := 0;
  H := Min(Integer(BitsPerInteger - 1), High(B));
  for I := 0 to H do
    if B[I] then
      Dest := SetBit(Dest, TBitRange(I));
end;

procedure BooleansToBits(var Dest: Int64; const B: TBooleanArray);
var
  I, H: Integer;
begin
  Dest := 0;
  H := Min(Int64(BitsPerInt64 - 1), High(B));
  for I := 0 to H do
    if B[I] then
      Dest := SetBit(Dest, TBitRange(I));
end;

procedure BitsToBooleans(const Bits: Byte; var B: TBooleanArray; AllBits: Boolean);
var
  I: Integer;
begin
  if AllBits then
    SetLength(B, BitsPerByte)
  else
    SetLength(B, BitsNeeded(Bits));
  for I := 0 to High(B) do
    B[I] := TestBit(Bits, TBitRange(I));
end;

procedure BitsToBooleans(const Bits: Word; var B: TBooleanArray; AllBits: Boolean);
var
  I: Integer;
begin
  if AllBits then
    SetLength(B, BitsPerWord)
  else
    SetLength(B, BitsNeeded(Bits));
  for I := 0 to High(B) do
    B[I] := TestBit(Bits, TBitRange(I));
end;

procedure BitsToBooleans(const Bits: Integer; var B: TBooleanArray; AllBits: Boolean);
var
  I: Integer;
begin
  if AllBits then
    SetLength(B, BitsPerInteger)
  else
    SetLength(B, BitsNeeded(Bits));
  for I := 0 to High(B) do
    B[I] := TestBit(Bits, TBitRange(I));
end;

procedure BitsToBooleans(const Bits: Int64; var B: TBooleanArray; AllBits: Boolean);
var
  I: Integer;
begin
  if AllBits then
    SetLength(B, BitsPerInt64)
  else
    SetLength(B, BitsNeeded(Bits));
  for I := 0 to High(B) do
    B[I] := TestBit(Bits, TBitRange(I));
end;

function Digits(const X: Cardinal): Integer;
var
  Val: Cardinal;
begin
  Result := 0;
  Val := X;
  repeat
    Inc(Result);
    Val := Val div 10;
  until Val = 0;
end;

function BitsNeeded(const X: Byte): Integer;
begin
  Result := BitsHighest(X) + 1;
  if Result = 0 then
    Result := 1;
end;

function BitsNeeded(const X: Word): Integer;
begin
  Result := BitsHighest(X) + 1;
  if Result = 0 then
    Result := 1;
end;

function BitsNeeded(const X: Integer): Integer;
begin
  Result := BitsHighest(X) + 1;
  if Result = 0 then
    Result := 1;
end;

function BitsNeeded(const X: Int64): Integer;
begin
  Result := BitsHighest(X) + 1;
  if Result = 0 then
    Result := 1;
end;

function ReverseBytes(Value: Word): Word;
begin
  Result := ((Value and Word($FF00)) shr BitsPerByte) or ((Value and Word($00FF)) shl BitsPerByte);
end;

function ReverseBytes(Value: Smallint): Smallint;
begin
  Result := ((Value and Smallint($FF00)) shr BitsPerByte) or ((Value and Smallint($00FF)) shl BitsPerByte);
end;

function ReverseBytes(Value: Integer): Integer;
var
  I: Integer;
begin
  Result := Value and ByteMask;
  Value := Value shr BitsPerByte;
  for I := 0 to SizeOf(Integer) - 2  do
  begin
    Result := (Result shl BitsPerByte) or (Value and ByteMask);
    Value := Value shr BitsPerByte;
  end;
end;

function ReverseBytes(Value: Cardinal): Cardinal;
var
  I: Integer;
begin
  Result := Value and ByteMask;
  Value := Value shr BitsPerByte;
  for I := 0 to SizeOf(Cardinal) - 2 do
  begin
    Result := (Result shl BitsPerByte) or (Value and ByteMask);
    Value := Value shr BitsPerByte;
  end;
end;

function ReverseBytes(Value: Int64): Int64;
var
  I: Integer;
begin
  Result := Value and ByteMask;
  Value := Value shr BitsPerByte;
  for I := 0 to SizeOf(Int64) - 2 do
  begin
    Result := (Result shl BitsPerByte) or (Value and ByteMask);
    Value := Value shr BitsPerByte;
  end;
end;

function ReverseBytes(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 := P1^;
      P1^ := P2^;
      P2^ := T;
      Inc(P1);
      Dec(P2);
    end;
  end;
  Result := P;
end;

// Arithmetic
procedure SwapOrd(var I, J: Byte);
var
  T: Byte;
begin
  T := I;
  I := J;
  J := T;
end;

procedure SwapOrd(var I, J: Cardinal);
var
  T: Cardinal;
begin
  T := I;
  I := J;
  J := T;
end;

procedure SwapOrd(var I, J: Integer);
var
  T: Integer;
begin
  T := I;
  I := J;
  J := T;
end;