[fpc-devel] HTML string to TFPColor

[Bart]

On 7/23/17, Bart <bartjunk64 at gmail.com> wrote:


> My try ...

Forget previous post...
This should make more sense.


resourcestring
  SInvalidHtmlColor = '"%s" is not a valid Html color';

{ 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;

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
    case LowerCase(S) of
      'white'  : begin Result := True; FPColor.red := $ff;
FPColor.green := $ff; FPColor.blue := $ff; end;
      'silver' : begin Result := True; FPColor.red := $c0;
FPColor.green := $c0; FPColor.blue := $c0; end;
      'gray'   : begin Result := True; FPColor.red := $80;
FPColor.green := $80; FPColor.blue := $80; end;
      'black'  : begin Result := True; FPColor.red := $00;
FPColor.green := $00; FPColor.blue := $00; end;
      'red'    : begin Result := True; FPColor.red := $ff;
FPColor.green := $00; FPColor.blue := $00; end;
      'maroon' : begin Result := True; FPColor.red := $80;
FPColor.green := $00; FPColor.blue := $00; end;
      'yellow' : begin Result := True; FPColor.red := $ff;
FPColor.green := $00; FPColor.blue := $00; end;
      'olive'  : begin Result := True; FPColor.red := $80;
FPColor.green := $80; FPColor.blue := $00; end;
      'lime'   : begin Result := True; FPColor.red := $00;
FPColor.green := $ff; FPColor.blue := $00; end;
      'green'  : begin Result := True; FPColor.red := $00;
FPColor.green := $80; FPColor.blue := $00; end;
      'aqua'   : begin Result := True; FPColor.red := $00;
FPColor.green := $ff; FPColor.blue := $ff; end;
      'teal'   : begin Result := True; FPColor.red := $00;
FPColor.green := $80; FPColor.blue := $80; end;
      'blue'   : begin Result := True; FPColor.red := $00;
FPColor.green := $00; FPColor.blue := $ff; end;
      'navy'   : begin Result := True; FPColor.red := $00;
FPColor.green := $00; FPColor.blue := $80; end;
      'fuchsia': begin Result := True; FPColor.red := $ff;
FPColor.green := $00; FPColor.blue := $ff; end;
      'purple' : begin Result := True; FPColor.red := $80;
FPColor.green := $00; FPColor.blue := $80; end;
    end;
  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