unit CSSColors;
interface
uses Graphics, SysUtils, SubUtils, HSLColors;
type
TColorName = record
Name: string;
Value: TColor;
end;
TCSSColorType = (ctNotColor, ctKeyword, ctHexadecimal, ctDecimal, ctPercentage);
function CSSColor(S: string; DefaultColor: TColor = clDefault): TColor; overload;
function CSSColor(S: string; out ColorType: TCSSColorType; DefaultColor: TColor = clDefault; SysToRGB: Boolean = False): TColor; overload;
function _RGB(Color: TColor): string; overload;
function _Hex(Color: TColor): string; overload;
function _Percent(Color: TColor): string; overload;
function _Keyword(Color: TColor; ColorType: TCSSColorType = ctHexadecimal; SysToRGB: Boolean = False): string;
procedure UnSystem(var Color: TColor); overload;
function Find(const S: string; const A: array of TColorName; var Value: TColor): Boolean; overload;
function Find(const Color: TColor; const A: array of TColorName; out Name: string): Boolean; overload;
var
KeywordColors: array[1..17] of TColorName = (
(Name: 'Aqua'; Value: clAqua ),
(Name: 'Black'; Value: clBlack ),
(Name: 'Blue'; Value: clBlue ),
(Name: 'Fuchsia'; Value: clFuchsia ),
(Name: 'Gray'; Value: clGray ),
(Name: 'Green'; Value: clGreen ),
(Name: 'Lime'; Value: clLime ),
(Name: 'Maroon'; Value: clMaroon ),
(Name: 'Navy'; Value: clNavy ),
(Name: 'Olive'; Value: clOlive ),
(Name: 'Orange'; Value: $00A5ff ),
(Name: 'Purple'; Value: clPurple ),
(Name: 'Red'; Value: clRed ),
(Name: 'Silver'; Value: clSilver ),
(Name: 'Teal'; Value: clTeal ),
(Name: 'White'; Value: clWhite ),
(Name: 'Yellow'; Value: clYellow )
);
SystemColors: array[1..28] of TColorName = (
(Name: 'ActiveBorder'; Value: clActiveBorder),
(Name: 'ActiveCaption'; Value: clActiveCaption),
(Name: 'AppWorkspace'; Value: clAppWorkspace),
(Name: 'Background'; Value: clBackground),
(Name: 'ButtonFace'; Value: clBtnFace),
(Name: 'ButtonHighlight'; Value: clBtnHighlight),
(Name: 'ButtonShadow'; Value: clBtnShadow),
(Name: 'ButtonText'; Value: clBtnText),
(Name: 'CaptionText'; Value: clCaptionText),
(Name: 'GrayText'; Value: clGrayText),
(Name: 'Highlight'; Value: clHighlight),
(Name: 'HighlightText'; Value: clHighlightText),
(Name: 'InactiveBorder'; Value: clInactiveBorder),
(Name: 'InactiveCaption'; Value: clInactiveCaption),
(Name: 'InactiveCaptionText'; Value: clInactiveCaptionText),
(Name: 'InfoBackground'; Value: clInfoBk),
(Name: 'InfoText'; Value: clInfoText),
(Name: 'Menu'; Value: clMenu),
(Name: 'MenuText'; Value: clMenuText),
(Name: 'Scrollbar'; Value: clScrollbar),
(Name: 'ThreeDDarkShadow'; Value: cl3DDkShadow),
(Name: 'ThreeDFace'; Value: clBtnFace),
(Name: 'ThreeDHighlight'; Value: clBtnHighlight),
(Name: 'ThreeDLightShadow'; Value: clBtnFace),
(Name: 'ThreeDShadow'; Value: clBtnShadow),
(Name: 'Window'; Value: clWindow),
(Name: 'WindowFrame'; Value: clWindowFrame),
(Name: 'WindowText'; Value: clWindowText)
);
RenderColors: array[1..2] of TColorName = (
(Name: 'inherit'; Value: clDefault),
(Name: 'transparent'; Value: clNone)
);
VerbalColors: array[1..138] of TColorName = (
(Name:'Aliceblue' ; Value:$FFF8F0),
(Name:'Antiquewhite' ; Value:$D7EBFA),
(Name:'Aqua' ; Value:$FFFF00),
(Name:'Aquamarine' ; Value:$D4FF7F),
(Name:'Azure' ; Value:$FFFFF0),
(Name:'Beige' ; Value:$DCF5F5),
(Name:'Bisque' ; Value:$C4E4FF),
(Name:'Black' ; Value:$000000),
(Name:'Blanchedalmond' ; Value:$CDEBFF),
(Name:'Blue' ; Value:$FF0000),
(Name:'Blueviolet' ; Value:$E22B8A),
(Name:'Brown' ; Value:$2A2AA5),
(Name:'Burlywood' ; Value:$87B8DE),
(Name:'Cadetblue' ; Value:$A09E5F),
(Name:'Chartreuse' ; Value:$00FF7F),
(Name:'Chocolate' ; Value:$1E69D2),
(Name:'Coral' ; Value:$507FFF),
(Name:'Cornflowerblue' ; Value:$ED9564),
(Name:'Cornsilk' ; Value:$DCF8FF),
(Name:'Crimson' ; Value:$3C14DC),
(Name:'Darkblue' ; Value:$8B0000),
(Name:'Darkcyan' ; Value:$8B8B00),
(Name:'Darkgoldenrod' ; Value:$0B86B8),
(Name:'Darkgray' ; Value:$A9A9A9),
(Name:'Darkgreen' ; Value:$006400),
(Name:'Darkkhaki' ; Value:$6BB7BD),
(Name:'Darkmagenta' ; Value:$8B008B),
(Name:'Darkolivegreen' ; Value:$2F6B55),
(Name:'Darkorange' ; Value:$008CFF),
(Name:'Darkorchid' ; Value:$CC3299),
(Name:'Darkred' ; Value:$00008B),
(Name:'Darksalmon' ; Value:$7A96E9),
(Name:'Darkseagreen' ; Value:$8FBC8F),
(Name:'Darkslateblue' ; Value:$8B3D48),
(Name:'Darkslategray' ; Value:$4F4F2F),
(Name:'Darkturquoise' ; Value:$D1CE00),
(Name:'Darkviolet' ; Value:$D30094),
(Name:'Deeppink' ; Value:$9314FF),
(Name:'Deepskyblue' ; Value:$FFBF00),
(Name:'Dimgray' ; Value:$696969),
(Name:'Dodgerblue' ; Value:$FF901E),
(Name:'Firebrick' ; Value:$2222B2),
(Name:'Floralwhite' ; Value:$F0FAFF),
(Name:'Forestgreen' ; Value:$228B22),
(Name:'Fuchsia' ; Value:$FF00FF),
(Name:'Gainsboro' ; Value:$DCDCDC),
(Name:'Ghostwhite' ; Value:$FFF8F8),
(Name:'Gold' ; Value:$00D7FF),
(Name:'Goldenrod' ; Value:$20A5DA),
(Name:'Gray' ; Value:$808080),
(Name:'Green' ; Value:$008000),
(Name:'Greenyellow' ; Value:$2FFFAD),
(Name:'Honeydew' ; Value:$F0FFF0),
(Name:'Hotpink' ; Value:$B469FF),
(Name:'Indianred' ; Value:$5C5CCD),
(Name:'Indigo' ; Value:$82004B),
(Name:'Ivory' ; Value:$F0FFFF),
(Name:'Khaki' ; Value:$8CE6F0),
(Name:'Lavender' ; Value:$FAE6E6),
(Name:'Lavenderblush' ; Value:$F5F0FF),
(Name:'Lawngreen' ; Value:$00FC7C),
(Name:'Lemonchiffon' ; Value:$CDFAFF),
(Name:'Lightblue' ; Value:$E6D8AD),
(Name:'Lightcoral' ; Value:$8080F0),
(Name:'Lightcyan' ; Value:$FFFFE0),
(Name:'Lightgoldenrodyellow' ; Value:$D2FAFA),
(Name:'Lightgray' ; Value:$D3D3D3),
(Name:'Lightgreen' ; Value:$90EE90),
(Name:'Lightpink' ; Value:$C1B6FF),
(Name:'Lightsalmon' ; Value:$7AA0FF),
(Name:'Lightseagreen' ; Value:$AAB220),
(Name:'Lightskyblue' ; Value:$FACE87),
(Name:'Lightslategray' ; Value:$998877),
(Name:'Lightsteelblue' ; Value:$DEC4B0),
(Name:'Lightyellow' ; Value:$E0FFFF),
(Name:'Lime' ; Value:$00FF00),
(Name:'Limegreen' ; Value:$32CD32),
(Name:'Linen' ; Value:$E6F0FA),
(Name:'Maroon' ; Value:$000080),
(Name:'Mediumaquamarine' ; Value:$AACD66),
(Name:'Mediumblue' ; Value:$CD0000),
(Name:'Mediumorchid' ; Value:$D355BA),
(Name:'Mediumpurple' ; Value:$DB7093),
(Name:'Mediumseagreen' ; Value:$71B33C),
(Name:'Mediumslateblue' ; Value:$EE687B),
(Name:'Mediumspringgreen' ; Value:$9AFA00),
(Name:'Mediumturquoise' ; Value:$CCD148),
(Name:'Mediumvioletred' ; Value:$8515C7),
(Name:'Midnightblue' ; Value:$701919),
(Name:'Mintcream' ; Value:$FAFFF5),
(Name:'Mistyrose' ; Value:$E1E4FF),
(Name:'Moccasin' ; Value:$B5E4FF),
(Name:'Navajowhite' ; Value:$ADDEFF),
(Name:'Navy' ; Value:$800000),
(Name:'Oldlace' ; Value:$E6F5FD),
(Name:'Olive' ; Value:$008080),
(Name:'Olivedrab' ; Value:$238E6B),
(Name:'Orange' ; Value:$00A5FF),
(Name:'Orangered' ; Value:$0045FF),
(Name:'Orchid' ; Value:$D670DA),
(Name:'Palegoldenrod' ; Value:$AAE8EE),
(Name:'Palegreen' ; Value:$98FB98),
(Name:'Paleturquoise' ; Value:$EEEEAF),
(Name:'Palevioletred' ; Value:$9370DB),
(Name:'Papayawhip' ; Value:$D5EFFF),
(Name:'Peachpuff' ; Value:$B9DAFF),
(Name:'Peru' ; Value:$3F85CD),
(Name:'Pink' ; Value:$CBC0FF),
(Name:'Plum' ; Value:$DDA0DD),
(Name:'Powderblue' ; Value:$E6E0B0),
(Name:'Purple' ; Value:$800080),
(Name:'Red' ; Value:$0000FF),
(Name:'Rosybrown' ; Value:$8F8FBC),
(Name:'Royalblue' ; Value:$E16941),
(Name:'Saddlebrown' ; Value:$13458B),
(Name:'Salmon' ; Value:$7280FA),
(Name:'Sandybrown' ; Value:$60A4F4),
(Name:'Seagreen' ; Value:$578B2E),
(Name:'Seashell' ; Value:$EEF5FF),
(Name:'Sienna' ; Value:$2D52A0),
(Name:'Silver' ; Value:$C0C0C0),
(Name:'Skyblue' ; Value:$EBCE87),
(Name:'Slateblue' ; Value:$CD5A6A),
(Name:'Slategray' ; Value:$908070),
(Name:'Snow' ; Value:$FAFAFF),
(Name:'Springgreen' ; Value:$7FFF00),
(Name:'Steelblue' ; Value:$B48246),
(Name:'Tan' ; Value:$8CB4D2),
(Name:'Teal' ; Value:$808000),
(Name:'Thistle' ; Value:$D8BFD8),
(Name:'Tomato' ; Value:$4763FF),
(Name:'Turquoise' ; Value:$D0E040),
(Name:'Violet' ; Value:$EE82EE),
(Name:'Wheat' ; Value:$B3DEF5),
(Name:'White' ; Value:$FFFFFF),
(Name:'Whitesmoke' ; Value:$F5F5F5),
(Name:'Yellow' ; Value:$00FFFF),
(Name:'Yellowgreen' ; Value:$32CD9A)
);
SynonymColors: array[1..9] of TColorName = (
(Name:'Cyan' ; Value:$FFFF00),
(Name:'Darkgrey' ; Value:$A9A9A9),
(Name:'Darkslategrey' ; Value:$4F4F2F),
(Name:'Dimgrey' ; Value:$696969),
(Name:'Grey' ; Value:$808080),
(Name:'Lightgrey' ; Value:$D3D3D3),
(Name:'Lightslategrey' ; Value:$998877),
(Name:'Magenta' ; Value:$FF00FF),
(Name:'Slategrey' ; Value:$908070)
);
const
Hex: array[0..15] of Char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
implementation
uses Windows;
function Find(const S: string; const A: array of TColorName; var Value: TColor): Boolean; overload;
var
L, M, H: Integer;
begin
L:=Low(A);
H:=High(A);
repeat
M:=(L+H) shr 1;
case CompareAsText(A[M].Name, S) of
-1: L:=M+1;
+1: H:=M-1;
else begin Value:=A[M].Value; Result:=True; Exit; end;
end;
until L > H;
Result:=False;
end;
function Find(const Color: TColor; const A: array of TColorName; out Name: string): Boolean; overload;
var
i: Integer;
begin
for i:=Low(A) to High(A) do if Color=A[i].Value then
begin
Name:=A[i].Name;
Result:=True;
Exit;
end;
Result:=False;
end;
function CSSColor(S: string; DefaultColor: TColor = clDefault): TColor; overload;
var
ColorType: TCSSColorType;
begin
Result:=CSSColor(S, ColorType, DefaultColor);
end;
function CSSColor(S: string; out ColorType: TCSSColorType; DefaultColor: TColor = clDefault; SysToRGB: Boolean = False): TColor; overload;
var
C: TARGB absolute Result;
Value: TColor absolute Result;
function IsHex: Boolean;
const
HexVal: array['0'..'F'] of Byte =(0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,0,10,11,12,13,14,15);
var
i: Integer;
begin
Result:=False;
if S[1]<>'#' then Exit;
for i:=2 to Length(S) do if not (S[i] in ['0'..'9', 'A'..'F']) then Exit;
case Length(S) of
4:
begin
C.R:=HexVal[S[2]]+(HexVal[S[2]] shl 4);
C.G:=HexVal[S[3]]+(HexVal[S[3]] shl 4);
C.B:=HexVal[S[4]]+(HexVal[S[4]] shl 4);
end;
7:
begin
C.R:=HexVal[S[3]]+(HexVal[S[2]] shl 4);
C.G:=HexVal[S[5]]+(HexVal[S[4]] shl 4);
C.B:=HexVal[S[7]]+(HexVal[S[6]] shl 4);
end;
else Exit;
end;
C.A:=$00;
Result:=True;
ColorType:=ctHexadecimal;
end;
function IsRGB: Boolean;
function RGBSpace(S: string; out N: Byte): Boolean;
function Alter(I: Integer): Byte;
begin
if I<0 then Result:=0 else
if I>255 then Result:=255 else Result:=I;
end;
var
I: Integer;
begin
Result:=False;
N:=0;
S:=Trim(S);
if Length(S)=0 then Exit;
if S[Length(S)]='%' then
begin
SetLength(S, Length(S)-1);
Result:=TryStrToInt(S,I);
if Result then N:=Alter(Round(I/100*255));
end else
begin
Result:=TryStrToInt(S,I);
if Result then N:=Alter(I);
end;
end;
var
i,j: Integer;
begin
Result:=False;
if (Sub(S,0,5)='RGB(') and (S[Length(S)]=')') then
begin
i:=4;
j:=PosOf(',',S,i);
if not RGBSpace(Sub(S, i, j), C.R) then Exit;
i:=j;
j:=PosOf(',',S,i+1);
if not RGBSpace(Sub(S, i, j), C.G) then Exit;
i:=j;
j:=Length(S);
if not RGBSpace(Sub(S, i, j), C.B) then Exit;
Result:=True;
C.A:=$00;
if Pos('%', S)<>0 then ColorType:=ctPercentage else ColorType:=ctDecimal;
end;
end;
function IsName: Boolean;
begin
Result:=Find(S, KeywordColors, Value) or Find(S, RenderColors, Value);
if not Result then
begin
Result:=Find(S, SystemColors, Value);
if Result and SysToRGB then UnSystem(Value);
end;
if Result then ColorType:=ctKeyword;
end;
begin
S:=UpperCase(Trim(S));
if (S='') or not (IsHex or IsRGB or IsName) then
begin
ColorType:=ctNotColor;
Result:=DefaultColor;
end;
end;
procedure UnSystem(var Color: TColor);
var
C: TARGB absolute Color;
begin
if C.A=$FF then Color:=GetSysColor(C.R);
end;
function _Hex(Color: TColor): string;
var
A: array[1..4] of Byte absolute Color;
i: Integer;
B: Boolean;
begin
UnSystem(Color);
SetLength(Result, 4);
Result[1]:='#';
B:=True;
for i:=1 to 3 do B:=B and ((A[i] and $0F)=(A[i] shr 4));
if B then for i:=1 to 3 do Result[i+1]:=Hex[A[i] shr 4] else
begin
SetLength(Result, 7);
for i:=1 to 3 do
begin
Result[i*2+1]:=Hex[A[i] and $0F];
Result[i*2 ]:=Hex[A[i] shr 4 ];
end;
end;
end;
function _RGB(Color: TColor): string;
var
C: TARGB absolute Color;
begin
UnSystem(Color);
Result:='rgb('+_(C.R)+','+_(C.G)+','+_(C.B)+')';
end;
function _Percent(Color: TColor): string;
function P(B: Byte): string;
begin
Result:=_(Round(B/255*100))+'%';
end;
var
C: TARGB absolute Color;
begin
UnSystem(Color);
Result:='rgb('+P(C.R)+','+P(C.G)+','+P(C.B)+')';
end;
function _Keyword(Color: TColor; ColorType: TCSSColorType = ctHexadecimal; SysToRGB: Boolean = False): string;
begin
if not SysToRGB and Find(Color,SystemColors,Result) or Find(Color,RenderColors,Result) then Exit;
if Find(Color,KeywordColors,Result) then Exit else
case ColorType of
ctDecimal: Result:=_RGB(Color);
ctPercentage: Result:=_Percent(Color);
else Result:=_Hex(Color);
end;
end;
end.