Convert color to/from HTML/es

From Free Pascal wiki
Jump to navigationJump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

English (en) español (es) français (fr)

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;

//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.

Ver también