[fpc-devel] HTML string to TFPColor

[Bart]

On 7/23/17, Bart <bartjunk64 at 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