[fpc-devel] HTML string to TFPColor
Hello! I couldn't find a function that converts a #RRGGBB color to TFPColor in FPC sources. I only found HTMLToFPColor in Lazarus /trunk/components/tachart/tahtml.pas IMO it is a fairly general function and should be in FPC sources. What do you FPC developers think? Ondrej ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On Sun, 23 Jul 2017, Ondrej Pokorny wrote: Hello! I couldn't find a function that converts a #RRGGBB color to TFPColor in FPC sources. I only found HTMLToFPColor in Lazarus /trunk/components/tachart/tahtml.pas IMO it is a fairly general function and should be in FPC sources. What do you FPC developers think? Agreed. Feel free to submit a patch. Michael. ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 23.07.2017 12:51, Michael Van Canneyt wrote: Agreed. Feel free to submit a patch. Great, I will! Ondrej ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 7/23/17, Ondrej Pokorny 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 ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 7/23/17, Bart 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@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
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 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@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
Re: [fpc-devel] HTML string to TFPColor
On 7/23/17, Michael Van Canneyt wrote: > Can you refactor the huge case to use a local proc? > it hurts my eyes... Yes I can. But obviously it will keep hurting your eyes, but just in a different place in the sourcecode? Bart ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On Sun, 23 Jul 2017, Bart wrote: On 7/23/17, Michael Van Canneyt wrote: Can you refactor the huge case to use a local proc? it hurts my eyes... Yes I can. But obviously it will keep hurting your eyes, but just in a different place in the sourcecode? I meant something like: Procedure rgb(r,g,b : word); begin FPColor.Red:=R; FPColor.Blue:=B; FPColor.Green:=G; Result:=True; end; begin // some code case LowerCase(S) of 'white': RGB($FF,$FF,$FF); 'silver' : RGB($c0;$c0,$c0); // etc end; Is IMHO infinitely more readable. I cherish the hope I am not alone in this? If you're worried about speed, add inline; but I think the case statement is inefficient enough not to worry about an additional call. Michael. ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 7/23/17, Bart 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
Re: [fpc-devel] HTML string to TFPColor
On 23.07.2017 14:39, Bart wrote: { 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; Actually I wanted to use an advanced record for this (the other functions are from the same unit): TFPColor = record red,green,blue,alpha : word; public *constructor CreateFromHTML(const HTML: string; AllowConstantNames: Boolean);* constructor Create(r,g,b,a:word); constructor Create(r,g,b:word); function AlphaBlend (color2: TFPColor): TFPColor; function CalculateGray : word; end; Michael, is such refactoring wanted? (Of couse I'll keep the old normal functions as well.) +Btw. there are much more name constants: https://www.w3schools.com/colors/colors_names.asp Ondrej ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 7/23/17, Ondrej Pokorny wrote: > +Btw. there are much more name constants: > https://www.w3schools.com/colors/colors_names.asp My set is W3C compliant ... Bart ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 23.07.2017 15:50, Bart wrote: On 7/23/17, Ondrej Pokorny wrote: +Btw. there are much more name constants: https://www.w3schools.com/colors/colors_names.asp My set is W3C compliant ... Ah, I see you use only the W3C basic colors https://www.w3.org/wiki/CSS/Properties/color/keywords It's OK then :) Ondrej ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 7/23/17, Ondrej Pokorny wrote: > Ah, I see you use only the W3C basic colors > https://www.w3.org/wiki/CSS/Properties/color/keywords https://www.w3.org/TR/css3-color/#colorunits Actually, adding more colornames is fine with me, itś just a tedious job ... Bart ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 23.07.2017 15:25, Michael Van Canneyt wrote: I think the case statement is inefficient enough not to worry about an additional call. There is IdentToInt function in Classes that makes this more efficient. IdentToColor from Graphics.pas uses it as well. Ondrej ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 23.07.2017 16:08, Ondrej Pokorny wrote: On 23.07.2017 15:25, Michael Van Canneyt wrote: I think the case statement is inefficient enough not to worry about an additional call. There is IdentToInt function in Classes that makes this more efficient. IdentToColor from Graphics.pas uses it as well. Actually not, I wrongly assumed it takes a sorted array and uses binary search... Ondrej ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
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 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 := HtmlColorNameToFP
Re: [fpc-devel] HTML string to TFPColor
On 7/23/17, ListMember wrote: > How about this. To me it is more readable. > > type >THtmlColorName = ( > *hcnUnknown*, hcnWhite, hcnSilver, hcnGray, hcnBlack, I dismissed that idea, becuase now you would have to have an entry in HtmlColorNameToFPColorMap for hcnUnknown, which makes no sense to me. Bart ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On Sun, 23 Jul 2017, Bart wrote: On 7/23/17, ListMember wrote: How about this. To me it is more readable. type THtmlColorName = ( *hcnUnknown*, hcnWhite, hcnSilver, hcnGray, hcnBlack, I dismissed that idea, becuase now you would have to have an entry in HtmlColorNameToFPColorMap for hcnUnknown, which makes no sense to me. Inserted this version, without the hcnUnknown. fpimage unit, rev. 36774. Many thanks to all ! Michael. ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
El 23/07/2017 a las 16:05, Bart escribió: https://www.w3.org/TR/css3-color/#colorunits Actually, adding more colornames is fine with me, itś just a tedious job ... Hello, If somebody needs it: type HTMLStandardColor=record ColorName: string; Red: BYTE; Green: BYTE; Blue: BYTE; end; const HTMLStandardColors: array [0..147] of HTMLStandardColor=( (ColorName:'AliceBlue';Red:$F0;Green:$F8;Blue:$FF), (ColorName:'AntiqueWhite';Red:$FA;Green:$EB;Blue:$D7), (ColorName:'Aqua';Red:$00;Green:$FF;Blue:$FF), (ColorName:'Aquamarine';Red:$7F;Green:$FF;Blue:$D4), (ColorName:'Azure';Red:$F0;Green:$FF;Blue:$FF), (ColorName:'Beige';Red:$F5;Green:$F5;Blue:$DC), (ColorName:'Bisque';Red:$FF;Green:$E4;Blue:$C4), (ColorName:'Black';Red:$00;Green:$00;Blue:$00), (ColorName:'BlanchedAlmond';Red:$FF;Green:$EB;Blue:$CD), (ColorName:'Blue';Red:$00;Green:$00;Blue:$FF), (ColorName:'BlueViolet';Red:$8A;Green:$2B;Blue:$E2), (ColorName:'Brown';Red:$A5;Green:$2A;Blue:$2A), (ColorName:'BurlyWood';Red:$DE;Green:$B8;Blue:$87), (ColorName:'CadetBlue';Red:$5F;Green:$9E;Blue:$A0), (ColorName:'Chartreuse';Red:$7F;Green:$FF;Blue:$00), (ColorName:'Chocolate';Red:$D2;Green:$69;Blue:$1E), (ColorName:'Coral';Red:$FF;Green:$7F;Blue:$50), (ColorName:'CornflowerBlue';Red:$64;Green:$95;Blue:$ED), (ColorName:'Cornsilk';Red:$FF;Green:$F8;Blue:$DC), (ColorName:'Crimson';Red:$DC;Green:$14;Blue:$3C), (ColorName:'Cyan';Red:$00;Green:$FF;Blue:$FF), (ColorName:'DarkBlue';Red:$00;Green:$00;Blue:$8B), (ColorName:'DarkCyan';Red:$00;Green:$8B;Blue:$8B), (ColorName:'DarkGoldenRod';Red:$B8;Green:$86;Blue:$0B), (ColorName:'DarkGray';Red:$A9;Green:$A9;Blue:$A9), (ColorName:'DarkGrey';Red:$A9;Green:$A9;Blue:$A9), (ColorName:'DarkGreen';Red:$00;Green:$64;Blue:$00), (ColorName:'DarkKhaki';Red:$BD;Green:$B7;Blue:$6B), (ColorName:'DarkMagenta';Red:$8B;Green:$00;Blue:$8B), (ColorName:'DarkOliveGreen';Red:$55;Green:$6B;Blue:$2F), (ColorName:'DarkOrange';Red:$FF;Green:$8C;Blue:$00), (ColorName:'DarkOrchid';Red:$99;Green:$32;Blue:$CC), (ColorName:'DarkRed';Red:$8B;Green:$00;Blue:$00), (ColorName:'DarkSalmon';Red:$E9;Green:$96;Blue:$7A), (ColorName:'DarkSeaGreen';Red:$8F;Green:$BC;Blue:$8F), (ColorName:'DarkSlateBlue';Red:$48;Green:$3D;Blue:$8B), (ColorName:'DarkSlateGray';Red:$2F;Green:$4F;Blue:$4F), (ColorName:'DarkSlateGrey';Red:$2F;Green:$4F;Blue:$4F), (ColorName:'DarkTurquoise';Red:$00;Green:$CE;Blue:$D1), (ColorName:'DarkViolet';Red:$94;Green:$00;Blue:$D3), (ColorName:'DeepPink';Red:$FF;Green:$14;Blue:$93), (ColorName:'DeepSkyBlue';Red:$00;Green:$BF;Blue:$FF), (ColorName:'DimGray';Red:$69;Green:$69;Blue:$69), (ColorName:'DimGrey';Red:$69;Green:$69;Blue:$69), (ColorName:'DodgerBlue';Red:$1E;Green:$90;Blue:$FF), (ColorName:'FireBrick';Red:$B2;Green:$22;Blue:$22), (ColorName:'FloralWhite';Red:$FF;Green:$FA;Blue:$F0), (ColorName:'ForestGreen';Red:$22;Green:$8B;Blue:$22), (ColorName:'Fuchsia';Red:$FF;Green:$00;Blue:$FF), (ColorName:'Gainsboro';Red:$DC;Green:$DC;Blue:$DC), (ColorName:'GhostWhite';Red:$F8;Green:$F8;Blue:$FF), (ColorName:'Gold';Red:$FF;Green:$D7;Blue:$00), (ColorName:'GoldenRod';Red:$DA;Green:$A5;Blue:$20), (ColorName:'Gray';Red:$80;Green:$80;Blue:$80), (ColorName:'Grey';Red:$80;Green:$80;Blue:$80), (ColorName:'Green';Red:$00;Green:$80;Blue:$00), (ColorName:'GreenYellow';Red:$AD;Green:$FF;Blue:$2F), (ColorName:'HoneyDew';Red:$F0;Green:$FF;Blue:$F0), (ColorName:'HotPink';Red:$FF;Green:$69;Blue:$B4), (ColorName:'IndianRed';Red:$CD;Green:$5C;Blue:$5C), (ColorName:'Indigo';Red:$4B;Green:$00;Blue:$82), (ColorName:'Ivory';Red:$FF;Green:$FF;Blue:$F0), (ColorName:'Khaki';Red:$F0;Green:$E6;Blue:$8C), (ColorName:'Lavender';Red:$E6;Green:$E6;Blue:$FA), (ColorName:'LavenderBlush';Red:$FF;Green:$F0;Blue:$F5), (ColorName:'LawnGreen';Red:$7C;Green:$FC;Blue:$00), (ColorName:'LemonChiffon';Red:$FF;Green:$FA;Blue:$CD), (ColorName:'LightBlue';Red:$AD;Green:$D8;Blue:$E6), (ColorName:'LightCoral';Red:$F0;Green:$80;Blue:$80), (ColorName:'LightCyan';Red:$E0;Green:$FF;Blue:$FF), (ColorName:'LightGoldenRodYellow';Red:$FA;Green:$FA;Blue:$D2), (ColorName:'LightGray';Red:$D3;Green:$D3;Blue:$D3), (ColorName:'LightGrey';Red:$D3;Green:$D3;Blue:$D3), (ColorName:'LightGreen';Red:$90;Green:$EE;Blue:$90), (ColorName:'LightPink';Red:$FF;Green:$B6;Blue:$C1), (ColorName:'LightSalmon';Red:$FF;Green:$A0;Blue:$7A), (ColorName:'LightSeaGreen';Red:$20;Green:$B2;Blue:$AA), (ColorName:'LightSkyBlue';Red:$87;Green:$CE;Blue:$FA), (ColorName:'LightSlateGray';Red:$77;Green:$88;Blue:$99), (ColorName:'LightSlateGrey';Red:$77;Green:$88;Blue:$99), (ColorName:'LightSteelBlue';Red:$B0;Green:$C4;Blue:$DE), (ColorName:'LightYellow';Red:$FF;Green:$FF;Blue:$E0), (ColorName:'Lime';Red:$00;Green:$FF;Blue:$00), (ColorName:'LimeGreen';Red:$32;Green:$CD;Blue:$32), (ColorName:'Linen';Red:$FA;Green:$F0;Blue:$E6), (ColorName:'Magenta';
Re: [fpc-devel] HTML string to TFPColor
On 23.07.2017 16:42, Michael Van Canneyt wrote: Inserted this version, without the hcnUnknown. fpimage unit, rev. 36774. Thank you Bart & Michael! I am building FPC trunk right now :) Ondrej ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On 7/23/17, Ondrej Pokorny wrote: > Thank you Bart & Michael! I am building FPC trunk right now :) My pleasure. It was on my private ToDo list anyway. Bart ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
Another, related topic would be: Replacement of HTML entities, e.g. convert a string such as 'cm2' to 'cm2', or 'sin α + cos β' to the one with the correct greek symbols (utf8). I have a solution in TAChart, unit TAHtml, but maybe (probably...) there's a better one. ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On Sun, 23 Jul 2017, Werner Pamler wrote: Another, related topic would be: Replacement of HTML entities, e.g. convert a string such as 'cm2' to 'cm2', or 'sin α + cos β' to the one with the correct greek symbols (utf8). I have a solution in TAChart, unit TAHtml, but maybe (probably...) there's a better one. This exists: function ResolveHTMLEntityReference(const Name: WideString; var Entity: WideChar): Boolean; is in unit htmldefs, fcl-xml package. Michael. ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
Am 23.07.2017 um 18:09 schrieb Michael Van Canneyt: This exists: function ResolveHTMLEntityReference(const Name: WideString; var Entity: WideChar): Boolean; is in unit htmldefs, fcl-xml package. Thank you. Seeking more carefully would have saved me a lot of tedious typing... Replaced my own routine by this one, and it is working fine. BTW: Wouldn't it be useful to overload it with a utf8 version? 2nd remark: The sax unit in the same folder is also WideString-only. From the Lazarus point of view, UTF8 would be preferrable as well. I remember older experiments trying to read Excel files with sax which suffered from a significant slowdown because of widestring-to-utf8 conversions. ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
Re: [fpc-devel] HTML string to TFPColor
On Sun, 23 Jul 2017, Werner Pamler wrote: Am 23.07.2017 um 18:09 schrieb Michael Van Canneyt: This exists: function ResolveHTMLEntityReference(const Name: WideString; var Entity: WideChar): Boolean; is in unit htmldefs, fcl-xml package. Thank you. Seeking more carefully would have saved me a lot of tedious typing... Replaced my own routine by this one, and it is working fine. BTW: Wouldn't it be useful to overload it with a utf8 version? It could be. Patches gladly accepted. 2nd remark: The sax unit in the same folder is also WideString-only. From the Lazarus point of view, UTF8 would be preferrable as well. I remember older experiments trying to read Excel files with sax which suffered from a significant slowdown because of widestring-to-utf8 conversions. The whole XML implementation in FPC is using Unicodestring. Changing the sax unit to UTF8 does not make sense. Michael. ___ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel