Sign in Join
Wiki copytemporary

Convert color to/from HTML/es: what changed

Revision 1 to 2. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
1-Esta unidad contine funciones para convertir un valor TColor a/desde una cadena de color HTML. También puede convertir una cadena HTML #rgb.
1+Esta unidad contine funciones para convertir un valor TColor a/desde una cadena de color HTML. También puede convertir una cadena HTML \#rgb.
22
3-Author: [User:Alextp](</User:Alextp> "User:Alextp")
4-```
3+Author: User:Alextp
4+
5+``` pascal
56unit ATStringProc_HtmlColor;
6-
7- {$mode objfpc}{$H+}
8-
9- interface
10-
11- uses
12- Classes, SysUtils, Graphics;
13-
14- //Convertir de TColor -> Cadena de color HTML #rrggbb (rojoverdeazul).
15- function SColorToHtmlColor(Color: TColor): string;
16- //Convertir una cadena que comienza con un token de color HTML color token #rgb, #rrggbb -> TColor, obtener len de la cadena de color.
17- function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor;
18-
19-
20- implementation
21-
22- function IsCharWord(ch: char): boolean;
23- begin
24- Result:= ch in ['a'..'z', 'A'..'Z', '_', '0'..'9']; // Saber si son caracteres en este rango, con resultado booleano.
25- end;
26-
27- function IsCharHex(ch: char): boolean; // Saber si es un carácter hexadecimal admitido con resultado booleano.
28- begin
29- Result:= ch in ['0'..'9', 'a'..'f', 'A'..'F'];
30- end;
31-
32- function SColorToHtmlColor(Color: TColor): string; // Conversión de TColor a Color HTML, devolviendo un String.
33- begin
34- if Color=clNone then
35- begin Result:= ''; exit end;
36- Result:= IntToHex(ColorToRGB(Color), 6);
37- Result:= '#'+Copy(Result, 5, 2)+Copy(Result, 3, 2)+Copy(Result, 1, 2);
38- end;
39-
40- function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor; // Conversión de Color HTML a TColor, devolviendo un TColor.
41- var
42- N1, N2, N3: integer;
43- i: integer;
44- begin
45- Result:= Default;
46- Len:= 0;
47- if (s<>'') and (s[1]='#') then Delete(s, 1, 1);
48- if (s='') then exit;
49-
50- //delete after first nonword char
51- i:= 1;
52- while (i<=Length(s)) and IsCharWord(s[i]) do Inc(i);
53- Delete(s, i, Maxint);
54-
55- //Permitir solamente #rgb, #rrggbb
56- Len:= Length(s);
57- if (Len<>3) and (Len<>6) then exit;
58-
59- for i:= 1 to Len do
60- if not IsCharHex(s[i]) then exit;
61-
62- if Len=6 then
63- begin
64- N1:= StrToInt('$'+Copy(s, 1, 2));
65- N2:= StrToInt('$'+Copy(s, 3, 2));
66- N3:= StrToInt('$'+Copy(s, 5, 2));
67- end
68- else
69- begin
70- N1:= StrToInt('$'+s[1]+s[1]);
71- N2:= StrToInt('$'+s[2]+s[2]);
72- N3:= StrToInt('$'+s[3]+s[3]);
73- end;
74-
75- Result:= N1 + N2 shl 8 + N3 shl 16;
76- end;
77-
78-
79- end.
7+
8+{$mode objfpc}{$H+}
9+
10+interface
11+
12+uses
13+ Classes, SysUtils, Graphics;
14+
15+//Convertir de TColor -> Cadena de color HTML #rrggbb (rojoverdeazul).
16+function SColorToHtmlColor(Color: TColor): string;
17+//Convertir una cadena que comienza con un token de color HTML color token #rgb, #rrggbb -> TColor, obtener len de la cadena de color.
18+function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor;
19+
20+implementation
21+
22+function IsCharWord(ch: char): boolean;
23+begin
24+ Result:= ch in ['a'..'z', 'A'..'Z', '_', '0'..'9']; // Saber si son caracteres en este rango, con resultado booleano.
25+end;
26+
27+function IsCharHex(ch: char): boolean; // Saber si es un carácter hexadecimal admitido con resultado booleano.
28+begin
29+ Result:= ch in ['0'..'9', 'a'..'f', 'A'..'F'];
30+end;
31+
32+function SColorToHtmlColor(Color: TColor): string; // Conversión de TColor a Color HTML, devolviendo un String.
33+begin
34+ if Color=clNone then
35+ begin Result:= ''; exit end;
36+ Result:= IntToHex(ColorToRGB(Color), 6);
37+ Result:= '#'+Copy(Result, 5, 2)+Copy(Result, 3, 2)+Copy(Result, 1, 2);
38+end;
39+
40+function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor; // Conversión de Color HTML a TColor, devolviendo un TColor.
41+var
42+ N1, N2, N3: integer;
43+ i: integer;
44+begin
45+ Result:= Default;
46+ Len:= 0;
47+ if (s<>'') and (s[1]='#') then Delete(s, 1, 1);
48+ if (s='') then exit;
49+
50+ //delete after first nonword char
51+ i:= 1;
52+ while (i<=Length(s)) and IsCharWord(s[i]) do Inc(i);
53+ Delete(s, i, Maxint);
54+
55+ //Permitir solamente #rgb, #rrggbb
56+ Len:= Length(s);
57+ if (Len<>3) and (Len<>6) then exit;
58+
59+ for i:= 1 to Len do
60+ if not IsCharHex(s[i]) then exit;
61+
62+ if Len=6 then
63+ begin
64+ N1:= StrToInt('$'+Copy(s, 1, 2));
65+ N2:= StrToInt('$'+Copy(s, 3, 2));
66+ N3:= StrToInt('$'+Copy(s, 5, 2));
67+ end
68+ else
69+ begin
70+ N1:= StrToInt('$'+s[1]+s[1]);
71+ N2:= StrToInt('$'+s[2]+s[2]);
72+ N3:= StrToInt('$'+s[3]+s[3]);
73+ end;
74+
75+ Result:= N1 + N2 shl 8 + N3 shl 16;
76+end;
77+
78+end.
8079```
8180
8281## Ver también
8382
84- * [Talk:Convert_color_to/from_HTML](</Talk:Convert_color_to/from_HTML> "Talk:Convert color to/from HTML")
83+- Talk:Convert_color_to/from_HTML
8584
8685---
87-*From the Free Pascal wiki, page "Convert color to/from HTML/es", as the Internet Archive kept it on 2025-02-11. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*
86+*From the Free Pascal wiki, page "Convert color to/from HTML/es", as it stood on 2020-02-12 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history