Convert color to/from HTML/fr: what changed
Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.
Title: Convert color to/from HTML/fr
| Old | New | Line | |
|---|---|---|---|
| 1 | + | Cette unité a des fonctions qui convertissent une valeur TColor de/vers une chaîne de couleur HTML: \#rrggbb. Elle peut aussi convertir des chaînes de couleur HTML: \#rgb. | |
| 2 | + | ||
| 3 | + | Auteur: User:Alextp | |
| 4 | + | ||
| 5 | + | ``` pascal | |
| 6 | + | unit ATStringProc_HtmlColor; | |
| 7 | + | ||
| 8 | + | {$mode objfpc}{$H+} | |
| 9 | + | ||
| 10 | + | interface | |
| 11 | + | ||
| 12 | + | uses | |
| 13 | + | Classes, SysUtils, Graphics; | |
| 14 | + | ||
| 15 | + | //convert TColor -> HTML color string #rrggbb | |
| 16 | + | function SColorToHtmlColor(Color: TColor): string; | |
| 17 | + | //convert string which starts with HTML color token #rgb, #rrggbb -> TColor, get len of color-string | |
| 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']; | |
| 25 | + | end; | |
| 26 | + | ||
| 27 | + | function IsCharHex(ch: char): boolean; | |
| 28 | + | begin | |
| 29 | + | Result:= ch in ['0'..'9', 'a'..'f', 'A'..'F']; | |
| 30 | + | end; | |
| 31 | + | ||
| 32 | + | function SColorToHtmlColor(Color: TColor): string; | |
| 33 | + | var | |
| 34 | + | N: Longint; | |
| 35 | + | begin | |
| 36 | + | if Color=clNone then | |
| 37 | + | begin Result:= ''; exit end; | |
| 38 | + | N:= ColorToRGB(Color); | |
| 39 | + | Result:= '#'+ | |
| 40 | + | IntToHex(Red(N), 2)+ | |
| 41 | + | IntToHex(Green(N), 2)+ | |
| 42 | + | IntToHex(Blue(N), 2); | |
| 43 | + | end; | |
| 44 | + | ||
| 45 | + | function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor; | |
| 46 | + | var | |
| 47 | + | N1, N2, N3: integer; | |
| 48 | + | i: integer; | |
| 49 | + | begin | |
| 50 | + | Result:= Default; | |
| 51 | + | Len:= 0; | |
| 52 | + | if (s<>'') and (s[1]='#') then Delete(s, 1, 1); | |
| 53 | + | if (s='') then exit; | |
| 54 | + | ||
| 55 | + | //delete after first nonword char | |
| 56 | + | i:= 1; | |
| 57 | + | while (i<=Length(s)) and IsCharWord(s[i]) do Inc(i); | |
| 58 | + | Delete(s, i, Maxint); | |
| 59 | + | ||
| 60 | + | //allow only #rgb, #rrggbb | |
| 61 | + | Len:= Length(s); | |
| 62 | + | if (Len<>3) and (Len<>6) then exit; | |
| 63 | + | ||
| 64 | + | for i:= 1 to Len do | |
| 65 | + | if not IsCharHex(s[i]) then exit; | |
| 66 | + | ||
| 67 | + | if Len=6 then | |
| 68 | + | begin | |
| 69 | + | N1:= StrToInt('$'+Copy(s, 1, 2)); | |
| 70 | + | N2:= StrToInt('$'+Copy(s, 3, 2)); | |
| 71 | + | N3:= StrToInt('$'+Copy(s, 5, 2)); | |
| 72 | + | end | |
| 73 | + | else | |
| 74 | + | begin | |
| 75 | + | N1:= StrToInt('$'+s[1]+s[1]); | |
| 76 | + | N2:= StrToInt('$'+s[2]+s[2]); | |
| 77 | + | N3:= StrToInt('$'+s[3]+s[3]); | |
| 78 | + | end; | |
| 79 | + | ||
| 80 | + | Result:= RGBToColor(N1, N2, N3); | |
| 81 | + | end; | |
| 82 | + | ||
| 83 | + | end. | |
| 84 | + | ``` | |
| 85 | + | ||
| 86 | + | ## Voir aussi | |
| 87 | + | ||
| 88 | + | - Talk:Convert_color_to/from_HTML | |
| 89 | + | ||
| 90 | + | --- | |
| 91 | + | *From the Free Pascal wiki, page "Convert color to/from HTML/fr", 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).* |