// mitjastachowiak.de


unit ColorTools;

{$mode objfpc}{$H+}

interface

uses Math;

type
 ARGBColor = packed record
  A,R,G,B : Byte;
 end;
 BGRAColor = packed record
  B,G,R,A : Byte;
 end;
 RGBColor = record
  R,G,B : Byte;
 end;
 RGBAColor = packed record
  R,G,B,A : Byte;
 end;

function StrToBGRA(const Str : AnsiString) : Cardinal;
function BGRAToStr(BGRA : Cardinal) : AnsiString;
function BGRAToRGB(BGRA : Cardinal) : Cardinal;
function RGBToBGRA(RGB : Cardinal) : Cardinal;

implementation

function ByteToChar(B : Byte) : Char;
begin
 Result := Char(0);
 case (B) of
  0 : Result := '0';
  1 : Result := '1';
  2 : Result := '2';
  3 : Result := '3';
  4 : Result := '4';
  5 : Result := '5';
  6 : Result := '6';
  7 : Result := '7';
  8 : Result := '8';
  9 : Result := '9';
  10 : Result := 'A';
  11 : Result := 'B';
  12 : Result := 'C';
  13 : Result := 'D';
  14 : Result := 'E';
  15 : Result := 'F';
 end;
end;

function CharToByte(C : Char) : Byte;
begin
 Result := 0;
 case (C) of
  '0' : Result := 0;
  '1' : Result := 1;
  '2' : Result := 2;
  '3' : Result := 3;
  '4' : Result := 4;
  '5' : Result := 5;
  '6' : Result := 6;
  '7' : Result := 7;
  '8' : Result := 8;
  '9' : Result := 9;
  'a' : Result := 10;
  'b' : Result := 11;
  'c' : Result := 12;
  'd' : Result := 13;
  'e' : Result := 14;
  'f' : Result := 15;
  'A' : Result := 10;
  'B' : Result := 11;
  'C' : Result := 12;
  'D' : Result := 13;
  'E' : Result := 14;
  'F' : Result := 15;
 end;
end;

function BGRAToRGB(BGRA : Cardinal) : Cardinal;
begin
 RGBAColor(Result).R := BGRAColor(BGRA).R;
 RGBAColor(Result).G := BGRAColor(BGRA).G;
 RGBAColor(Result).B := BGRAColor(BGRA).B;
 RGBAColor(Result).A := 0;
end;

function RGBToBGRA(RGB : Cardinal) : Cardinal;
begin
 BGRAColor(Result).R := RGBAColor(RGB).R;
 BGRAColor(Result).G := RGBAColor(RGB).G;
 BGRAColor(Result).B := RGBAColor(RGB).B;
 BGRAColor(Result).A := 255;
end;

function BGRAToStr(BGRA : Cardinal) : AnsiString;
var b : Byte;
begin
 SetLength(Result,8);
 b := Floor(PByte(@BGRA + 0)^ / 16);
 Result[6] := ByteToChar(PByte(@BGRA + 0)^ - b * 16);
 Result[5] := ByteToChar(b);
 b := Floor(PByte(@BGRA + 1)^ / 16);
 Result[4] := ByteToChar(PByte(@BGRA + 1)^ - b * 16);
 Result[3] := ByteToChar(b);
 b := Floor(PByte(@BGRA + 2)^ / 16);
 Result[2] := ByteToChar(PByte(@BGRA + 2)^ - b * 16);
 Result[1] := ByteToChar(b);
 b := Floor(PByte(@BGRA + 3)^ / 16);
 Result[8] := ByteToChar(PByte(@BGRA + 3)^ - b * 16);
 Result[7] := ByteToChar(b);
end;

function StrToBGRA(const Str : AnsiString) : Cardinal;
var b : Byte;
begin
 Result := 0;
 if (Length(Str) <> 8) then exit;
 b := CharToByte(Str[6]) + CharToByte(Str[5]) * 16;
 PByte(@Result + 0)^ := b;
 b := CharToByte(Str[4]) + CharToByte(Str[3]) * 16;
 PByte(@Result + 1)^ := b;
 b := CharToByte(Str[2]) + CharToByte(Str[1]) * 16;
 PByte(@Result + 2)^ := b;
 b := CharToByte(Str[8]) + CharToByte(Str[7]) * 16;
 PByte(@Result + 3)^ := b;
end;

end.