Convert color to/from HTML/es

unit ATStringProc_HtmlColor;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics;

//Convertir de TColor -> Cadena de color HTML #rrggbb (rojoverdeazul).
function SColorToHtmlColor(Color: TColor): string;
//Convertir una cadena que comienza con un token de color HTML color token #rgb, #rrggbb -> TColor,  obtener len de la cadena de color.
function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor;

implementation

function IsCharWord(ch: char): boolean;
begin
  Result:= ch in ['a'..'z', 'A'..'Z', '_', '0'..'9']; // Saber si son caracteres en este rango, con resultado booleano.
end;

function IsCharHex(ch: char): boolean; // Saber si es un carácter hexadecimal admitido con resultado booleano.
begin
  Result:= ch in ['0'..'9', 'a'..'f', 'A'..'F'];
end;

function SColorToHtmlColor(Color: TColor): string; // Conversión de TColor a Color HTML, devolviendo un String.
begin
  if Color=clNone then
    begin Result:= ''; exit end;
  Result:= IntToHex(ColorToRGB(Color), 6);
  Result:= '#'+Copy(Result, 5, 2)+Copy(Result, 3, 2)+Copy(Result, 1, 2);
end;

function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor; // Conversión de Color HTML a TColor, devolviendo un TColor.
var
  N1, N2, N3: integer;
  i: integer;
begin
  Result:= Default;
  Len:= 0;
  if (s<>'') and (s[1]='#') then Delete(s, 1, 1);
  if (s='') then exit;

  //delete after first nonword char
  i:= 1;
  while (i<=Length(s)) and IsCharWord(s[i]) do Inc(i);
  Delete(s, i, Maxint);

  //Permitir solamente #rgb, #rrggbb
  Len:= Length(s);
  if (Len<>3) and (Len<>6) then exit;

  for i:= 1 to Len do
    if not IsCharHex(s[i]) then exit;

  if Len=6 then
  begin
    N1:= StrToInt('$'+Copy(s, 1, 2));
    N2:= StrToInt('$'+Copy(s, 3, 2));
    N3:= StrToInt('$'+Copy(s, 5, 2));
  end
  else
  begin
    N1:= StrToInt('$'+s[1]+s[1]);
    N2:= StrToInt('$'+s[2]+s[2]);
    N3:= StrToInt('$'+s[3]+s[3]);
  end;

  Result:= N1 + N2 shl 8 + N3 shl 16;
end;

end.