Convert color to/from HTML/es
From Free Pascal wiki
Jump to navigationJump to searchThe 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.