[fpc-devel] HTML string to TFPColor

[ListMember]

How about this. To me it is more readable.

type
   THtmlColorName = (
*hcnUnknown*, hcnWhite, hcnSilver, hcnGray, hcnBlack,
     hcnRed, hcnMaroon, hcnYellow, hcnOlive,
     hcnLime, hcnGreen, hcnAqua, hcnTeal, hcnBlue,
     hcnNavy, hcnFuchsia, hcnPurple);

function TryStrToHtmlColorName(const S: String; out AName:
THtmlColorName): Boolean;
begin
*  Result := True;**
*  case LowerCase(S) of
     'white'  : AName := hcnWhite;
     'silver' : AName := hcnSilver;
     'gray'   : AName := hcnGray;
     'black'  : AName := hcnBlack;
     'red'    : AName := hcnRed;
     'maroon' : AName := hcnMaroon;
     'yellow' : AName := hcnYellow;
     'olive'  : AName := hcnOlive;
     'lime'   : AName := hcnLime;
     'green'  : AName := hcnGreen;
     'aqua'   : AName := hcnAqua;
     'teal'   : AName := hcnTeal;
     'blue'   : AName := hcnBlue;
     'navy'   : AName := hcnNavy;
     'fuchsia': AName := hcnFuchsia;
     'purple' : AName := hcnPurple;
*  else**
**    AName := hcnUnknown;**
**    Result := False;**
*  end;
end;


On 2017-07-23 16:46, Bart wrote:
> 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
> _______________________________________________
> fpc-devel maillist  -  fpc-devel at lists.freepascal.org
> http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-devel/attachments/20170723/ecca27d5/attachment.html>