Re: [fpc-devel] HTML string to TFPColor

[Michael Van Canneyt]

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

Re: [fpc-devel] HTML string to TFPColor

[Werner Pamler]

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

[Michael Van Canneyt]

On Sun, 23 Jul 2017, Werner Pamler wrote:

Another, related topic would be: Replacement of HTML entities, e.g. 
convert a string such as 'cmsup2/sup' 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

[Werner Pamler]

Another, related topic would be: Replacement of HTML entities, e.g. 
convert a string such as 'cmsup2/sup' 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

[Bart]

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

[Ondrej Pokorny]

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

[José Mejuto]

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),
  

Re: [fpc-devel] HTML string to TFPColor

[Michael Van Canneyt]

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

[Bart]

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

[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  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
   

Re: [fpc-devel] HTML string to TFPColor

[Ondrej Pokorny]

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

[Ondrej Pokorny]

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

[Bart]

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

[Ondrej Pokorny]

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

[Bart]

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

[Ondrej Pokorny]

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

[Bart]

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

[Michael Van Canneyt]

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

[Bart]

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

[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  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

[Bart]

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

[Bart]

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

[Ondrej Pokorny]

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

[Michael Van Canneyt]

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

[fpc-devel] HTML string to TFPColor

[Ondrej Pokorny]

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