[fpc-devel] HTML string to TFPColor

[Michael Van Canneyt]

Hi,

Can you refactor the huge case to use a local proc? 
it hurts my eyes...

Michael.

On Sun, 23 Jul 2017, Bart wrote:

> 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
> _______________________________________________
> fpc-devel maillist  -  fpc-devel at lists.freepascal.org
> http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel