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

_______________________________________________
fpc-devel maillist  -  fpc-devel@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel

Reply via email to