[fpc-devel] HTML string to TFPColor

[Bart]

On 7/23/17, Ondrej Pokorny <lazarus at kluug.net> wrote:

> Great, I will!

My try ...


{ Try to translate HTML color code into TFPColor
  Supports following formats
    '#rgb'
    '#rrggbb'
    W3C Html color name
}
function TryHtmlToFPColorDef(const S: String; out FPColor: TFPColor;
Def: 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 := Def;
  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;


Bart