f00577f5f4
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5549 8e941d3f-bd1b-0410-a28a-d453659cc2b4
323 lines
12 KiB
ObjectPascal
323 lines
12 KiB
ObjectPascal
unit HTMLColors;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, LCLIntf, Graphics, Variants;
|
|
|
|
const
|
|
SPECIAL_COUNT = 140;
|
|
WEBSAFE_COUNT = 216;
|
|
SYSTEM_COUNT = 28;
|
|
BASIC_COUNT = 16;
|
|
SPECIAL_HEX: array [0..139] of string = (
|
|
'000000', 'FAEBD7', '00FFFF', '7FFFD4', 'F0FFFF', 'F5F5DC', 'FFE4C4',
|
|
'F0F8FF', 'FFEBCD', '0000FF', '8A2BE2', 'A52A2A', 'DEB887', '5F9EA0',
|
|
'7FFF00', 'D2691E', 'FF7F50', '6495ED', 'FFF8DC', 'DC143C', '00FFFF',
|
|
'00008B', '008B8B', 'B8860B', 'A9A9A9', '006400', 'BDB76B', '8B008B',
|
|
'556B2F', 'FF8C00', '9932CC', '8B0000', 'E9967A', '8FBC8B', '483D8B',
|
|
'2F4F4F', '00CED1', '9400D3', 'FF1493', '00BFFF', '696969', '1E90FF',
|
|
'B22222', 'FFFAF0', '228B22', 'FF00FF', 'DCDCDC', 'F8F8FF', 'FFD700',
|
|
'DAA520', '808080', '008000', 'ADFF2F', 'F0FFF0', 'FF69B4', 'CD5C5C',
|
|
'4B0082', 'FFFFF0', 'F0E68C', 'E6E6FA', 'FFF0F5', '7CFC00', 'FFFACD',
|
|
'ADD8E6', 'F08080', 'E0FFFF', 'FAFAD2', '90EE90', 'D3D3D3', 'FFB6C1',
|
|
'FFA07A', '20B2AA', '87CEFA', '778899', 'B0C4DE', 'FFFFE0', '00FF00',
|
|
'32CD32', 'FAF0E6', 'FF00FF', '800000', '66CDAA', '0000CD', 'BA55D3',
|
|
'9370DB', '3CB371', '7B68EE', '00FA9A', '48D1CC', 'C71585', '191970',
|
|
'F5FFFA', 'FFE4E1', 'FFE4B5', 'FFDEAD', '000080', 'FDF5E6', '808000',
|
|
'6B8E23', 'FFA500', 'FF4500', 'DA70D6', 'EEE8AA', '98FB98', 'AFEEEE',
|
|
'DB7093', 'FFEFD5', 'FFDAB9', 'CD853F', 'FFC0CB', 'DDA0DD', 'B0E0E6',
|
|
'800080', 'FF0000', 'BC8F8F', '4169E1', '8B4513', 'FA8072', 'F4A460',
|
|
'2E8B57', 'FFF5EE', 'A0522D', 'C0C0C0', '87CEEB', '6A5ACD', '708090',
|
|
'FFFAFA', '00FF7F', '4682B4', 'D2B48C', '008080', 'D8BFD8', 'FF6347',
|
|
'40E0D0', 'EE82EE', 'F5DEB3', 'FFFFFF', 'F5F5F5', 'FFFF00', '9ACD32'
|
|
);
|
|
SPECIAL_NAMES: array [0..139] of string = (
|
|
'black', 'antiquewhite', 'aqua', 'aquamarine', 'azure', 'beige',
|
|
'bisque', 'aliceblue', 'blanchedalmond', 'blue', 'blueviolet', 'brown',
|
|
'burlywood', 'cadetblue', 'chartreuse', 'chocolate', 'coral',
|
|
'cornflower', 'cornsilk', 'crimson', 'cyan', 'darkblue', 'darkcyan',
|
|
'darkgoldenrod', 'darkgray', 'darkgreen', 'darkkhaki', 'darkmagenta',
|
|
'darkolivegreen', 'darkorange', 'darkorchid', 'darkred', 'darksalmon',
|
|
'darkseagreen', 'darkslateblue', 'darkslategray', 'darkturquoise',
|
|
'darkviolet', 'deeppink', 'deepskyblue', 'dimgray', 'dodgerblue',
|
|
'firebrick', 'floralwhite', 'forestgreen', 'fuchsia', 'gainsboro',
|
|
'ghostwhite', 'gold', 'goldenrod', 'gray', 'green', 'greenyellow',
|
|
'honeydew', 'hotpink', 'indianred', 'indigo', 'ivory', 'khaki', 'lavender',
|
|
'lavenderblush', 'lawngreen', 'lemonchiffon', 'lightblue', 'lightcoral',
|
|
'lightcyan', 'lightgoldenrodyellow', 'lightgreen', 'lightgray', 'lightpink',
|
|
'lightsalmon', 'lightseagreen', 'lightskyblue', 'lightslategray',
|
|
'lightsteelblue', 'lightyellow', 'lime', 'limegreen', 'linen', 'magenta',
|
|
'maroon', 'mediumaquamarine', 'mediumblue', 'mediumorchid', 'mediumpurple',
|
|
'mediumseagreen', 'mediumslateblue', 'mediumspringgreen', 'mediumturquoise',
|
|
'mediumvioletred', 'midnightblue', 'mintcream', 'mistyrose', 'moccasin',
|
|
'navajowhite', 'navy', 'oldlace', 'olive', 'olivedrab', 'orange', 'orangered',
|
|
'orchid', 'palegoldenrod', 'palegreen', 'paleturquoise', 'palevioletred',
|
|
'papayawhip', 'peachpuff', 'peru', 'pink', 'plum', 'powderblue', 'purple',
|
|
'red', 'rosybrown', 'royalblue', 'saddlebrown', 'salmon', 'sandybrown',
|
|
'seagreen', 'seashell', 'sienna', 'silver', 'skyblue', 'slateblue',
|
|
'slategray', 'snow', 'springgreen', 'steelblue', 'tan', 'teal', 'thistle',
|
|
'tomato', 'turquoise', 'violet', 'wheat', 'white', 'whitesmoke', 'yellow',
|
|
'yellowgreen'
|
|
);
|
|
WEBSAFE_HEX: array [0..215] of string = (
|
|
'000000' ,'000033' ,'000066' ,'000099' ,'0000cc' ,'0000ff',
|
|
'003300' ,'003333' ,'003366' ,'003399' ,'0033cc' ,'0033ff',
|
|
'006600' ,'006633' ,'006666' ,'006699' ,'0066cc' ,'0066ff',
|
|
'009900' ,'009933' ,'009966' ,'009999' ,'0099cc' ,'0099ff',
|
|
'00cc00' ,'00cc33' ,'00cc66' ,'00cc99' ,'00cccc' ,'00ccff',
|
|
'00ff00' ,'00ff33' ,'00ff66' ,'00ff99' ,'00ffcc' ,'00ffff',
|
|
'330000' ,'330033' ,'330066' ,'330099' ,'3300cc' ,'3300ff',
|
|
'333300' ,'333333' ,'333366' ,'333399' ,'3333cc' ,'3333ff',
|
|
'336600' ,'336633' ,'336666' ,'336699' ,'3366cc' ,'3366ff',
|
|
'339900' ,'339933' ,'339966' ,'339999' ,'3399cc' ,'3399ff',
|
|
'33cc00' ,'33cc33' ,'33cc66' ,'33cc99' ,'33cccc' ,'33ccff',
|
|
'33ff00' ,'33ff33' ,'33ff66' ,'33ff99' ,'33ffcc' ,'33ffff',
|
|
'660000' ,'660033' ,'660066' ,'660099' ,'6600cc' ,'6600ff',
|
|
'663300' ,'663333' ,'663366' ,'663399' ,'6633cc' ,'6633ff',
|
|
'666600' ,'666633' ,'666666' ,'666699' ,'6666cc' ,'6666ff',
|
|
'669900' ,'669933' ,'669966' ,'669999' ,'6699cc' ,'6699ff',
|
|
'66cc00' ,'66cc33' ,'66cc66' ,'66cc99' ,'66cccc' ,'66ccff',
|
|
'66ff00' ,'66ff33' ,'66ff66' ,'66ff99' ,'66ffcc' ,'66ffff',
|
|
'990000' ,'990033' ,'990066' ,'990099' ,'9900cc' ,'9900ff',
|
|
'993300' ,'993333' ,'993366' ,'993399' ,'9933cc' ,'9933ff',
|
|
'996600' ,'996633' ,'996666' ,'996699' ,'9966cc' ,'9966ff',
|
|
'999900' ,'999933' ,'999966' ,'999999' ,'9999cc' ,'9999ff',
|
|
'99cc00' ,'99cc33' ,'99cc66' ,'99cc99' ,'99cccc' ,'99ccff',
|
|
'99ff00' ,'99ff33' ,'99ff66' ,'99ff99' ,'99ffcc' ,'99ffff',
|
|
'cc0000' ,'cc0033' ,'cc0066' ,'cc0099' ,'cc00cc' ,'cc00ff',
|
|
'cc3300' ,'cc3333' ,'cc3366' ,'cc3399' ,'cc33cc' ,'cc33ff',
|
|
'cc6600' ,'cc6633' ,'cc6666' ,'cc6699' ,'cc66cc' ,'cc66ff',
|
|
'cc9900' ,'cc9933' ,'cc9966' ,'cc9999' ,'cc99cc' ,'cc99ff',
|
|
'cccc00' ,'cccc33' ,'cccc66' ,'cccc99' ,'cccccc' ,'ccccff',
|
|
'ccff00' ,'ccff33' ,'CCFF66' ,'ccff99' ,'ccffcc' ,'ccffff',
|
|
'ff0000' ,'ff0033' ,'ff0066' ,'ff0099' ,'ff00cc' ,'ff00ff',
|
|
'ff3300' ,'ff3333' ,'ff3366' ,'ff3399' ,'ff33cc' ,'ff33ff',
|
|
'ff6600' ,'ff6633' ,'ff6666' ,'ff6699' ,'ff66cc' ,'ff66ff',
|
|
'ff9900' ,'ff9933' ,'ff9966' ,'ff9999' ,'ff99cc' ,'ff99ff',
|
|
'ffcc00' ,'ffcc33' ,'ffcc66' ,'ffcc99' ,'ffcccc' ,'ffccff',
|
|
'ffff00' ,'ffff33' ,'ffff66' ,'ffff99' ,'ffffcc' ,'ffffff'
|
|
);
|
|
SYSTEM_VALUES: array [0..27] of TColor = (
|
|
clActiveBorder, clActiveCaption, clAppWorkspace, clBackground,
|
|
clBtnFace, clBtnHighlight, clBtnShadow, clBtnText, clCaptionText,
|
|
clGrayText, clHighlight, clHighlightText, clInactiveBorder,
|
|
clInactiveCaption, clInactiveCaptionText, clInfoBk, clInfoText,
|
|
clMenu, clMenuText, clScrollbar, cl3dDkShadow, cl3dLight,
|
|
clBtnHighlight, clActiveBorder, clBtnShadow, clWindow,
|
|
clWindowFrame, clWindowText
|
|
);
|
|
SYSTEM_NAMES: array [0..27] of string = (
|
|
'activeborder', 'activecaption', 'appworkspace', 'background',
|
|
'buttonface', 'buttonhighlight', 'buttonshadow', 'buttontext',
|
|
'captiontext', 'graytext', 'highlight', 'highlighttext',
|
|
'inactiveborder', 'inactivecaption', 'inactivecaptiontext',
|
|
'infobackground', 'infotext', 'menu', 'menutext', 'scrollbar',
|
|
'threeddarkshadow', 'threedface', 'threedhighlight',
|
|
'threedlightshadow', 'threedshadow', 'window', 'windowframe',
|
|
'windowtext'
|
|
);
|
|
BASIC_VALUES: array [0..15] of TColor = (
|
|
clBlack, clAqua, clBlue, clFuchsia, clGray, clGreen, clLime,
|
|
clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal,
|
|
clWhite, clYellow
|
|
);
|
|
BASIC_NAMES: array [0..15] of string = (
|
|
'black', 'aqua', 'blue', 'fuchsia', 'gray', 'green', 'lime',
|
|
'maroon', 'navy', 'olive', 'purple', 'red', 'silver', 'teal',
|
|
'white', 'yellow'
|
|
);
|
|
|
|
procedure MakeIntoHex(var s: string);
|
|
function IsMember(a: array of string; n: integer; s: string): boolean;
|
|
function IsSpecialColor(s: string): boolean;
|
|
function FormatHexColor(S: string): string;
|
|
function ColorToHex(Color: TColor): string;
|
|
function HexToTColor(s: OleVariant): TColor;
|
|
function GetHexFromName(s: string): string;
|
|
function GetValueFromName(s: string): TColor;
|
|
function IsWebSafe(s: string): boolean; overload;
|
|
function IsWebSafe(c: TColor): boolean; overload;
|
|
function GetWebSafe(C: TColor): TColor;
|
|
|
|
implementation
|
|
|
|
var
|
|
WS: array [0..255] of byte;
|
|
|
|
//checks membership of a string array
|
|
function IsMember(a: array of string; n: integer; s: string): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := false;
|
|
for i := 0 to n - 1 do
|
|
if SameText(s, a[i]) then
|
|
Result := true;
|
|
end;
|
|
|
|
//checks if the color's name was used instead of hex
|
|
function IsSpecialColor(s: string): boolean;
|
|
begin
|
|
Result := IsMember(BASIC_NAMES, BASIC_COUNT, s) or IsMember(SPECIAL_NAMES, SPECIAL_COUNT, s) or IsMember(SYSTEM_NAMES, SYSTEM_COUNT, s);
|
|
end;
|
|
|
|
//is hex was used then remove the wrong characters
|
|
procedure MakeIntoHex(var s: string);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if s <> '' then
|
|
for i := 1 to Length(s) do
|
|
if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
|
|
s[i] := '0';
|
|
end;
|
|
|
|
//formats entered text into a true hex value
|
|
function FormatHexColor(S: string): string;
|
|
var
|
|
c: string;
|
|
i: integer;
|
|
begin
|
|
c := '';
|
|
if not IsSpecialColor(s) then
|
|
begin
|
|
if (s <> '') and (s[1] = '#') then
|
|
Delete(s, 1, 1);
|
|
|
|
if s <> '' then
|
|
begin
|
|
MakeIntoHex(c);
|
|
if Length(c) = 6 then
|
|
Result := c
|
|
else
|
|
begin
|
|
if Length(c) > 6 then
|
|
c := Copy(c, 1, 6);
|
|
if Length(c) < 6 then
|
|
for i := 0 to 6 - Length(c) - 1 do
|
|
c := '0' + c;
|
|
Result := c;
|
|
end;
|
|
end
|
|
else
|
|
Result := '000000';
|
|
end
|
|
else
|
|
Result := s;
|
|
end;
|
|
|
|
//gets a hex value from a color name from special colors
|
|
function GetHexFromName(s: string): string;
|
|
var
|
|
i, k: integer;
|
|
begin
|
|
k := 0;
|
|
for i := 0 to SPECIAL_COUNT - 1 do
|
|
if SameText(s, SPECIAL_NAMES[i]) then
|
|
begin
|
|
k := i;
|
|
Break;
|
|
end;
|
|
Result := SPECIAL_HEX[k];
|
|
end;
|
|
|
|
// gets a TColor value from a color name from basic or system colors
|
|
function GetValueFromName(s: string): TColor;
|
|
var
|
|
i, k: integer;
|
|
begin
|
|
k := 0;
|
|
s := LowerCase(s);
|
|
if IsMember(BASIC_NAMES, BASIC_COUNT, s) then
|
|
begin
|
|
for i := 0 to BASIC_COUNT - 1 do
|
|
if SameText(s, BASIC_NAMES[i]) then
|
|
begin
|
|
k := i;
|
|
Break;
|
|
end;
|
|
Result := BASIC_VALUES[k];
|
|
end
|
|
else if IsMember(SYSTEM_NAMES, SYSTEM_COUNT, s) then
|
|
begin
|
|
for i := 0 to SYSTEM_COUNT - 1 do
|
|
if SameText(s, SYSTEM_NAMES[i]) then
|
|
begin
|
|
k := i;
|
|
Break;
|
|
end;
|
|
Result := SYSTEM_VALUES[k];
|
|
end
|
|
else
|
|
Result := clNone;
|
|
end;
|
|
|
|
//converts a TColor value to a hex value
|
|
function ColorToHex(Color: TColor): string;
|
|
begin
|
|
Result := IntToHex(GetRValue(Color), 2) + IntToHex(GetGValue(Color), 2) + IntToHex(GetBValue(Color), 2)
|
|
end;
|
|
|
|
//converts a hex value to a TColor
|
|
function HexToTColor(s: OleVariant): TColor;
|
|
begin
|
|
if s <> null then
|
|
begin
|
|
if not IsSpecialColor(s) then
|
|
begin
|
|
s := FormatHexColor(s);
|
|
if s <> '' then
|
|
Result := RGB(StrToInt('$'+Copy(S, 1, 2)), StrToInt('$'+Copy(S, 3, 2)), StrToInt('$'+Copy(S, 5, 2)))
|
|
else
|
|
Result := clNone;
|
|
end
|
|
else if IsMember(SPECIAL_NAMES, SPECIAL_COUNT, s) then
|
|
begin
|
|
s := GetHexFromName(s);
|
|
Result := RGB(StrToInt('$'+Copy(S, 1, 2)), StrToInt('$'+Copy(S, 3, 2)), StrToInt('$'+Copy(S, 5, 2)));
|
|
end
|
|
else
|
|
Result := GetValueFromName(s);
|
|
end
|
|
else
|
|
Result := clNone;
|
|
end;
|
|
|
|
//checks if a hex value belongs to the websafe palette
|
|
function IsWebSafe(s: string): boolean;
|
|
begin
|
|
s := FormatHexColor(s);
|
|
Result := IsMember(WEBSAFE_HEX, WEBSAFE_COUNT, s);
|
|
end;
|
|
|
|
//checks if a color belongs to the websafe palette
|
|
function IsWebSafe(c: TColor): boolean;
|
|
var
|
|
s: string;
|
|
begin
|
|
s := ColorToHex(c);
|
|
Result := IsMember(WEBSAFE_HEX, WEBSAFE_COUNT, s);
|
|
end;
|
|
|
|
//initializes the websafe comparison array
|
|
procedure InitializeWS;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to 255 do
|
|
WS[I] := ((i + $19) div $33) * $33;
|
|
end;
|
|
|
|
//returns the closest web safe color to the one given
|
|
function GetWebSafe(C: TColor): TColor;
|
|
begin
|
|
Result := RGB(WS[GetRValue(C)], WS[GetGValue(C)], WS[GetBValue(C)]);
|
|
end;
|
|
|
|
|
|
initialization
|
|
InitializeWS;
|
|
|
|
end.
|