On 7/23/17, Bart <bartjun...@gmail.com> wrote:
Hopefully less eye-sorrow ...
resourcestring
SInvalidHtmlColor = '"%s" is not a valid Html color';
type
THtmlColorName = (
hcnWhite, hcnSilver, hcnGray, hcnBlack,
hcnRed, hcnMaroon, hcnYellow, hcnOlive,
hcnLime, hcnGreen, hcnAqua, hcnTeal, hcnBlue,
hcnNavy, hcnFuchsia, hcnPurple);
const
HtmlColorNameToFPColorMap: array[THtmlColorName] of TFPColor = (
(red: $ff; green: $ff; blue: $ff; alpha: alphaOpaque), //hcnWhite
(red: $c0; green: $c0; blue: $c0; alpha: alphaOpaque), //hcnSilver
(red: $80; green: $80; blue: $80; alpha: alphaOpaque), //hcnGray
(red: $00; green: $00; blue: $00; alpha: alphaOpaque), //hcnBlack
(red: $ff; green: $00; blue: $00; alpha: alphaOpaque), //hcnRed
(red: $80; green: $00; blue: $00; alpha: alphaOpaque), //hcnMaroon
(red: $ff; green: $ff; blue: $00; alpha: alphaOpaque), //hcnYellow
(red: $80; green: $80; blue: $00; alpha: alphaOpaque), //hcnOlive
(red: $00; green: $ff; blue: $00; alpha: alphaOpaque), //hcnLime
(red: $00; green: $80; blue: $00; alpha: alphaOpaque), //hcnGreen
(red: $00; green: $ff; blue: $ff; alpha: alphaOpaque), //hcnAqua
(red: $00; green: $80; blue: $80; alpha: alphaOpaque), //hcnTeal
(red: $00; green: $00; blue: $ff; alpha: alphaOpaque), //hcnBlue
(red: $00; green: $00; blue: $80; alpha: alphaOpaque), //hcnNavy
(red: $ff; green: $00; blue: $ff; alpha: alphaOpaque), //hcnFuchsia
(red: $80; green: $00; blue: $80; alpha: alphaOpaque) //hcnPurple
);
function TryStrToHtmlColorName(const S: String; out AName:
THtmlColorName): Boolean;
begin
Result := False;
case LowerCase(S) of
'white' : begin Result := True; AName := hcnWhite; end;
'silver' : begin Result := True; AName := hcnSilver; end;
'gray' : begin Result := True; AName := hcnGray; end;
'black' : begin Result := True; AName := hcnBlack; end;
'red' : begin Result := True; AName := hcnRed; end;
'maroon' : begin Result := True; AName := hcnMaroon; end;
'yellow' : begin Result := True; AName := hcnYellow; end;
'olive' : begin Result := True; AName := hcnOlive; end;
'lime' : begin Result := True; AName := hcnLime; end;
'green' : begin Result := True; AName := hcnGreen; end;
'aqua' : begin Result := True; AName := hcnAqua; end;
'teal' : begin Result := True; AName := hcnTeal; end;
'blue' : begin Result := True; AName := hcnBlue; end;
'navy' : begin Result := True; AName := hcnNavy; end;
'fuchsia': begin Result := True; AName := hcnFuchsia; end;
'purple' : begin Result := True; AName := hcnPurple; end;
end;
end;
{ Try to translate HTML color code into TFPColor
Supports following formats
'#rgb'
'#rrggbb'
W3C Html color name
}
function TryHtmlToFPColor(const S: String; out FPColor: TFPColor): Boolean;
function TryHexStrToWord(const Hex: String; out W: Word): Boolean;
var
Code: Integer;
begin
Val('$'+Hex, W, Code);
Result := (Code = 0);
if not Result then W := 0;
end;
var
AName: THtmlColorName;
begin
Result := False;
FPColor.red := 0;
FPColor.green := 0;
FPColor.blue := 0;
FPColor.alpha := alphaOpaque;
if (Length(S) = 0) then
Exit;
if (S[1] = '#') then
begin
if Length(S) = 4 then
begin // #rgb
Result := (TryHexstrToWord(S[2]+S[2], FPColor.red) and
TryHexstrToWord(S[3]+S[3], FPColor.green) and
TryHexstrToWord(S[4]+S[4], FPColor.blue));
end
else if Length(S) = 7 then
begin // #rrggbb
Result := (TryHexstrToWord(S[2]+S[3], FPColor.red) and
TryHexstrToWord(S[4]+S[5], FPColor.green) and
TryHexstrToWord(S[6]+S[7], FPColor.blue));
end;
end
else
begin
Result := TryStrToHtmlColorName(S, AName);
if Result then
FPColor := HtmlColorNameToFPColorMap[AName];
end;
end;
function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def:
TFPColor): TFPColor;
begin
if not TryHtmlToFPColor(S, Result) then
Result := Def;
end;
function HtmlToFpColor(const S: String): TFPColor;
begin
if not TryHtmlToFpColor(S, Result) then
raise EConvertError.CreateFmt(SInvalidHtmlColor, [S]);
end;
Bart
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
