Convert color to/from HTML/es

Esta unidad contine funciones para convertir un valor TColor a/desde una cadena de color HTML. También puede convertir una cadena HTML #rgb.

Author: User:Alextp

unit ATStringProc_HtmlColor;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics;

//convert TColor -> Cadena de color HTML #rrggbb (rojoverdeazul).
function SColorToHtmlColor(Color: TColor): string;
//convert string which starts with HTML color token #rgb, #rrggbb -> TColor,  get len of color-string
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'];
end;

function IsCharHex(ch: char): boolean;
begin
  Result:= ch in ['0'..'9', 'a'..'f', 'A'..'F'];
end;

function SColorToHtmlColor(Color: TColor): 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;
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.

Ver también

• Talk:Convert_color_to/from_HTML