Convert color to/from HTML/es: what changed
Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.
Title: Convert color to/from HTML/es
| Old | New | Line | |
|---|---|---|---|
| 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. | |
| 2 | + | ||
| 3 | + | Author: [User:Alextp](</User:Alextp> "User:Alextp") | |
| 4 | + | ``` | |
| 5 | + | unit 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. | |
| 80 | + | ``` | |
| 81 | + | ||
| 82 | + | ## Ver también | |
| 83 | + | ||
| 84 | + | * [Talk:Convert_color_to/from_HTML](</Talk:Convert_color_to/from_HTML> "Talk:Convert color to/from HTML") | |
| 85 | + | ||
| 86 | + | --- | |
| 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).* |