system.uiconsts.pp 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994
  1. unit System.UIConsts;
  2. {
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 2023 the Free Pascal development team
  5. FPC/Lazarus Replacement for UIConsts from Delphi 10.x
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. }
  12. {$MODE OBJFPC}
  13. {$H+}
  14. {$R-}
  15. interface
  16. {$IFDEF FPC_DOTTEDUNITS}
  17. uses System.UITypes, System.Classes;
  18. {$ELSE}
  19. uses System.UITypes, Classes;
  20. {$ENDIF}
  21. const
  22. MaxColorChannel = $FF;
  23. const
  24. claAliceblue = TAlphaColors.AliceBlue;
  25. claAntiquewhite = TAlphaColors.Antiquewhite;
  26. claAqua = TAlphaColors.Aqua;
  27. claAquamarine = TAlphaColors.Aquamarine;
  28. claAzure = TAlphaColors.Azure;
  29. claBeige = TAlphaColors.Beige;
  30. claBisque = TAlphaColors.Bisque;
  31. claBlack = TAlphaColors.Black;
  32. claBlanchedalmond = TAlphaColors.Blanchedalmond;
  33. claBlue = TAlphaColors.Blue;
  34. claBlueviolet = TAlphaColors.Blueviolet;
  35. claBrown = TAlphaColors.Brown;
  36. claBurlywood = TAlphaColors.Burlywood;
  37. claCadetblue = TAlphaColors.Cadetblue;
  38. claChartreuse = TAlphaColors.Chartreuse;
  39. claChocolate = TAlphaColors.Chocolate;
  40. claCoral = TAlphaColors.Coral;
  41. claCornflowerblue = TAlphaColors.Cornflowerblue;
  42. claCornsilk = TAlphaColors.Cornsilk;
  43. claCrimson = TAlphaColors.Crimson;
  44. claCyan = TAlphaColors.Cyan;
  45. claDarkblue = TAlphaColors.Darkblue;
  46. claDarkcyan = TAlphaColors.Darkcyan;
  47. claDarkgoldenrod = TAlphaColors.Darkgoldenrod;
  48. claDarkgray = TAlphaColors.Darkgray;
  49. claDarkgreen = TAlphaColors.Darkgreen;
  50. claDarkgrey = TAlphaColors.Darkgrey;
  51. claDarkkhaki = TAlphaColors.Darkkhaki;
  52. claDarkmagenta = TAlphaColors.Darkmagenta;
  53. claDarkolivegreen = TAlphaColors.Darkolivegreen;
  54. claDarkorange = TAlphaColors.Darkorange;
  55. claDarkorchid = TAlphaColors.Darkorchid;
  56. claDarkred = TAlphaColors.Darkred;
  57. claDarksalmon = TAlphaColors.Darksalmon;
  58. claDarkseagreen = TAlphaColors.Darkseagreen;
  59. claDarkslateblue = TAlphaColors.Darkslateblue;
  60. claDarkslategray = TAlphaColors.Darkslategray;
  61. claDarkslategrey = TAlphaColors.Darkslategrey;
  62. claDarkturquoise = TAlphaColors.Darkturquoise;
  63. claDarkviolet = TAlphaColors.Darkviolet;
  64. claDeeppink = TAlphaColors.Deeppink;
  65. claDeepskyblue = TAlphaColors.Deepskyblue;
  66. claDimgray = TAlphaColors.Dimgray;
  67. claDimgrey = TAlphaColors.Dimgrey;
  68. claDodgerblue = TAlphaColors.Dodgerblue;
  69. claFirebrick = TAlphaColors.Firebrick;
  70. claFloralwhite = TAlphaColors.Floralwhite;
  71. claForestgreen = TAlphaColors.Forestgreen;
  72. claFuchsia = TAlphaColors.Fuchsia;
  73. claGainsboro = TAlphaColors.Gainsboro;
  74. claGhostwhite = TAlphaColors.Ghostwhite;
  75. claGold = TAlphaColors.Gold;
  76. claGoldenrod = TAlphaColors.Goldenrod;
  77. claGray = TAlphaColors.Gray;
  78. claGreen = TAlphaColors.Green;
  79. claGreenyellow = TAlphaColors.Greenyellow;
  80. claGrey = TAlphaColors.Grey;
  81. claHoneydew = TAlphaColors.Honeydew;
  82. claHotpink = TAlphaColors.Hotpink;
  83. claIndianred = TAlphaColors.Indianred;
  84. claIndigo = TAlphaColors.Indigo;
  85. claIvory = TAlphaColors.Ivory;
  86. claKhaki = TAlphaColors.Khaki;
  87. claLavender = TAlphaColors.Lavender;
  88. claLavenderblush = TAlphaColors.Lavenderblush;
  89. claLawngreen = TAlphaColors.Lawngreen;
  90. claLemonchiffon = TAlphaColors.Lemonchiffon;
  91. claLightblue = TAlphaColors.Lightblue;
  92. claLightcoral = TAlphaColors.Lightcoral;
  93. claLightcyan = TAlphaColors.Lightcyan;
  94. claLightgoldenrodyellow = TAlphaColors.Lightgoldenrodyellow;
  95. claLightgray = TAlphaColors.Lightgray;
  96. claLightgreen = TAlphaColors.Lightgreen;
  97. claLightgrey = TAlphaColors.Lightgrey;
  98. claLightpink = TAlphaColors.Lightpink;
  99. claLightsalmon = TAlphaColors.Lightsalmon;
  100. claLightseagreen = TAlphaColors.Lightseagreen;
  101. claLightskyblue = TAlphaColors.Lightskyblue;
  102. claLightslategray = TAlphaColors.Lightslategray;
  103. claLightslategrey = TAlphaColors.Lightslategrey;
  104. claLightsteelblue = TAlphaColors.Lightsteelblue;
  105. claLightyellow = TAlphaColors.Lightyellow;
  106. claLime = TAlphaColors.Lime;
  107. claLimegreen = TAlphaColors.Limegreen;
  108. claLinen = TAlphaColors.Linen;
  109. claMagenta = TAlphaColors.Magenta;
  110. claMaroon = TAlphaColors.Maroon;
  111. claMediumaquamarine = TAlphaColors.Mediumaquamarine;
  112. claMediumblue = TAlphaColors.Mediumblue;
  113. claMediumorchid = TAlphaColors.Mediumorchid;
  114. claMediumpurple = TAlphaColors.Mediumpurple;
  115. claMediumseagreen = TAlphaColors.Mediumseagreen;
  116. claMediumslateblue = TAlphaColors.Mediumslateblue;
  117. claMediumspringgreen = TAlphaColors.Mediumspringgreen;
  118. claMediumturquoise = TAlphaColors.Mediumturquoise;
  119. claMediumvioletred = TAlphaColors.Mediumvioletred;
  120. claMidnightblue = TAlphaColors.Midnightblue;
  121. claMintcream = TAlphaColors.Mintcream;
  122. claMistyrose = TAlphaColors.Mistyrose;
  123. claMoccasin = TAlphaColors.Moccasin;
  124. claNavajowhite = TAlphaColors.Navajowhite;
  125. claNavy = TAlphaColors.Navy;
  126. claOldlace = TAlphaColors.Oldlace;
  127. claOlive = TAlphaColors.Olive;
  128. claOlivedrab = TAlphaColors.Olivedrab;
  129. claOrange = TAlphaColors.Orange;
  130. claOrangered = TAlphaColors.Orangered;
  131. claOrchid = TAlphaColors.Orchid;
  132. claPalegoldenrod = TAlphaColors.Palegoldenrod;
  133. claPalegreen = TAlphaColors.Palegreen;
  134. claPaleturquoise = TAlphaColors.Paleturquoise;
  135. claPalevioletred = TAlphaColors.Palevioletred;
  136. claPapayawhip = TAlphaColors.Papayawhip;
  137. claPeachpuff = TAlphaColors.Peachpuff;
  138. claPeru = TAlphaColors.Peru;
  139. claPink = TAlphaColors.Pink;
  140. claPlum = TAlphaColors.Plum;
  141. claPowderblue = TAlphaColors.Powderblue;
  142. claPurple = TAlphaColors.Purple;
  143. claRed = TAlphaColors.Red;
  144. claRosybrown = TAlphaColors.Rosybrown;
  145. claRoyalblue = TAlphaColors.Royalblue;
  146. claSaddlebrown = TAlphaColors.Saddlebrown;
  147. claSalmon = TAlphaColors.Salmon;
  148. claSandybrown = TAlphaColors.Sandybrown;
  149. claSeagreen = TAlphaColors.Seagreen;
  150. claSeashell = TAlphaColors.Seashell;
  151. claSienna = TAlphaColors.Sienna;
  152. claSilver = TAlphaColors.Silver;
  153. claSkyblue = TAlphaColors.Skyblue;
  154. claSlateblue = TAlphaColors.Slateblue;
  155. claSlategray = TAlphaColors.Slategray;
  156. claSlategrey = TAlphaColors.Slategrey;
  157. claSnow = TAlphaColors.Snow;
  158. claSpringgreen = TAlphaColors.Springgreen;
  159. claSteelblue = TAlphaColors.Steelblue;
  160. claTan = TAlphaColors.Tan;
  161. claTeal = TAlphaColors.Teal;
  162. claThistle = TAlphaColors.Thistle;
  163. claTomato = TAlphaColors.Tomato;
  164. claTurquoise = TAlphaColors.Turquoise;
  165. claViolet = TAlphaColors.Violet;
  166. claWheat = TAlphaColors.Wheat;
  167. claWhite = TAlphaColors.White;
  168. claWhitesmoke = TAlphaColors.Whitesmoke;
  169. claYellow = TAlphaColors.Yellow;
  170. claYellowgreen = TAlphaColors.Yellowgreen;
  171. claNull = TAlphaColors.Null;
  172. { Cursor string functions }
  173. function CursorToString(Cursor: TCursor): string;
  174. function StringToCursor(const S: string): TCursor;
  175. procedure GetCursorValues(const Proc: TGetStrProc);
  176. function CursorToIdent(Cursor: LongInt; var Ident: string): Boolean; inline;
  177. function IdentToCursor(const Ident: string; var Cursor: LongInt): Boolean; inline;
  178. procedure RegisterCursorIntegerConsts;
  179. { TColor string functions }
  180. function ColorToString(Color: TColor): string;
  181. function StringToColor(const S: string): TColor;
  182. procedure GetColorValues(Proc: TGetStrProc);
  183. function ColorToIdent(Color: Longint; var Ident: string): Boolean; inline;
  184. function IdentToColor(const Ident: string; var Color: LongInt): Boolean; inline;
  185. procedure RegisterColorIntegerConsts;
  186. { TAlphaColor string functions }
  187. procedure GetAlphaColorValues(Proc: TGetStrProc);
  188. function AlphaColorToString(Value: TAlphaColor): string;
  189. function StringToAlphaColor(const Value: string): TAlphaColor;
  190. function AlphaColorToIdent(Color: LongInt; var Ident: string): Boolean;
  191. function IdentToAlphaColor(const Ident: string; var Color: Longint): Boolean;
  192. procedure RegisterAlphaColorIntegerConsts;
  193. { TAlphaColor function's }
  194. /// <summary>Converts TAlphaColor into TColor structure, exchanging red and blue channels while losing alpha channel. </summary>
  195. function AlphaColorToColor(const Color: TAlphaColor): TColor;
  196. function AppendColor(Start, Stop: TAlphaColor): TAlphaColor;
  197. function SubtractColor(Start, Stop: TAlphaColor): TAlphaColor;
  198. function RGBtoBGR(const C: TAlphaColor): TAlphaColor;
  199. function CorrectColor(const C: TAlphaColor): TAlphaColor;
  200. function PremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
  201. function UnpremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
  202. function MakeColor(R, G, B: Byte; A: Byte = MaxColorChannel): TAlphaColor; overload;
  203. function MakeColor(const C: TAlphaColor; const AOpacity: Single): TAlphaColor; overload;
  204. function HSLtoRGB(H, S, L: Single): TAlphaColor;
  205. procedure RGBtoHSL(RGB: TAlphaColor; out H, S, L: Single);
  206. function ChangeHSL(const C: TAlphaColor; dH, dS, dL: Single): TAlphaColor;
  207. const
  208. // Please keep these sorted.
  209. CursorNames: array[0..30] of TIdentMapEntry = (
  210. (Value: crAppStart; Name: 'crAppStart'),
  211. (Value: crArrow; Name: 'crArrow'),
  212. (Value: crCross; Name: 'crCross'),
  213. (Value: crDefault; Name: 'crDefault'),
  214. (Value: crDrag; Name: 'crDrag'),
  215. (Value: crHandPoint; Name: 'crHandPoint'),
  216. (Value: crHelp; Name: 'crHelp'),
  217. (Value: crHourGlass; Name: 'crHourGlass'),
  218. (Value: crHSplit; Name: 'crHSplit'),
  219. (Value: crIBeam; Name: 'crIBeam'),
  220. (Value: crMultiDrag; Name: 'crMultiDrag'),
  221. (Value: crNoDrop; Name: 'crNoDrop'),
  222. (Value: crNo; Name: 'crNo'),
  223. (Value: crSizeAll; Name: 'crSizeAll'),
  224. (Value: crSizeE; Name: 'crSizeE'),
  225. (Value: crSizeNE; Name: 'crSizeNE'),
  226. (Value: crSizeNESW; Name: 'crSizeNESW'),
  227. (Value: crSizeN; Name: 'crSizeN'),
  228. (Value: crSizeNS; Name: 'crSizeNS'),
  229. (Value: crSizeNW; Name: 'crSizeNW'),
  230. (Value: crSizeNWSE; Name: 'crSizeNWSE'),
  231. (Value: crSizeSE; Name: 'crSizeSE'),
  232. (Value: crSizeS; Name: 'crSizeS'),
  233. (Value: crSizeSW; Name: 'crSizeSW'),
  234. (Value: crSizeWE; Name: 'crSizeWE'),
  235. (Value: crSizeW; Name: 'crSizeW'),
  236. (Value: crSQLWait; Name: 'crSQLWait'),
  237. (Value: crUpArrow; Name: 'crUpArrow'),
  238. (Value: crVSplit; Name: 'crVSplit'),
  239. // These must be last, duplicates!
  240. (Value: crSize; Name: 'crSize'),
  241. (Value: crLow; Name: 'crLow')
  242. );
  243. // Please keep these sorted.
  244. ColorNames: array[0..51] of TIdentMapEntry = (
  245. (Value: TColors.Aqua; Name: 'clAqua'),
  246. (Value: TColors.Black; Name: 'clBlack'),
  247. (Value: TColors.Blue; Name: 'clBlue'),
  248. (Value: TColors.Cream; Name: 'clCream'),
  249. (Value: TColors.Fuchsia; Name: 'clFuchsia'),
  250. (Value: TColors.Gray; Name: 'clGray'),
  251. (Value: TColors.Green; Name: 'clGreen'),
  252. (Value: TColors.Lime; Name: 'clLime'),
  253. (Value: TColors.Maroon; Name: 'clMaroon'),
  254. (Value: TColors.MedGray; Name: 'clMedGray'),
  255. (Value: TColors.MoneyGreen; Name: 'clMoneyGreen'),
  256. (Value: TColors.Navy; Name: 'clNavy'),
  257. (Value: TColors.Olive; Name: 'clOlive'),
  258. (Value: TColors.Purple; Name: 'clPurple'),
  259. (Value: TColors.Red; Name: 'clRed'),
  260. (Value: TColors.Silver; Name: 'clSilver'),
  261. (Value: TColors.SkyBlue; Name: 'clSkyBlue'),
  262. (Value: TColors.Sys3DDkShadow; Name: 'cl3DDkShadow'),
  263. (Value: TColors.Sys3DLight; Name: 'cl3DLight'),
  264. (Value: TColors.SysActiveBorder; Name: 'clActiveBorder'),
  265. (Value: TColors.SysActiveCaption; Name: 'clActiveCaption'),
  266. (Value: TColors.SysAppWorkSpace; Name: 'clAppWorkSpace'),
  267. (Value: TColors.SysBackground; Name: 'clBackground'),
  268. (Value: TColors.SysBtnFace; Name: 'clBtnFace'),
  269. (Value: TColors.SysBtnHighlight; Name: 'clBtnHighlight'),
  270. (Value: TColors.SysBtnShadow; Name: 'clBtnShadow'),
  271. (Value: TColors.SysBtnText; Name: 'clBtnText'),
  272. (Value: TColors.SysCaptionText; Name: 'clCaptionText'),
  273. (Value: TColors.SysDefault; Name: 'clDefault'),
  274. (Value: TColors.SysGradientActiveCaption; Name: 'clGradientActiveCaption'),
  275. (Value: TColors.SysGradientInactiveCaption; Name: 'clGradientInactiveCaption'),
  276. (Value: TColors.SysGrayText; Name: 'clGrayText'),
  277. (Value: TColors.SysHighlight; Name: 'clHighlight'),
  278. (Value: TColors.SysHighlightText; Name: 'clHighlightText'),
  279. (Value: TColors.SysHotLight; Name: 'clHotLight'),
  280. (Value: TColors.SysInactiveBorder; Name: 'clInactiveBorder'),
  281. (Value: TColors.SysInactiveCaption; Name: 'clInactiveCaption'),
  282. (Value: TColors.SysInactiveCaptionText; Name: 'clInactiveCaptionText'),
  283. (Value: TColors.SysInfoBk; Name: 'clInfoBk'),
  284. (Value: TColors.SysInfoText; Name: 'clInfoText'),
  285. (Value: TColors.SysMenuBar; Name: 'clMenuBar'),
  286. (Value: TColors.SysMenuHighlight; Name: 'clMenuHighlight'),
  287. (Value: TColors.SysMenu; Name: 'clMenu'),
  288. (Value: TColors.SysMenuText; Name: 'clMenuText'),
  289. (Value: TColors.SysNone; Name: 'clNone'),
  290. (Value: TColors.SysScrollBar; Name: 'clScrollBar'),
  291. (Value: TColors.SysWindowFrame; Name: 'clWindowFrame'),
  292. (Value: TColors.SysWindow; Name: 'clWindow'),
  293. (Value: TColors.SysWindowText; Name: 'clWindowText'),
  294. (Value: TColors.Teal; Name: 'clTeal'),
  295. (Value: TColors.White; Name: 'clWhite'),
  296. (Value: TColors.Yellow; Name: 'clYellow')
  297. );
  298. AlphaColorNames: array [0..154] of TIdentMapEntry = (
  299. (Value: TAlphaColors.AliceBlue; Name: 'claAliceBlue'),
  300. (Value: TAlphaColors.Alpha; Name: 'claAlpha'),
  301. (Value: TAlphaColors.AntiqueWhite; Name: 'claAntiqueWhite'),
  302. (Value: TAlphaColors.AquaMarine; Name: 'claAquaMarine'),
  303. (Value: TAlphaColors.Aqua; Name: 'claAqua'),
  304. (Value: TAlphaColors.Azure; Name: 'claAzure'),
  305. (Value: TAlphaColors.Beige; Name: 'claBeige'),
  306. (Value: TAlphaColors.Bisque; Name: 'claBisque'),
  307. (Value: TAlphaColors.Black; Name: 'claBlack'),
  308. (Value: TAlphaColors.BlanchedAlmond; Name: 'claBlanchedAlmond'),
  309. (Value: TAlphaColors.Blue; Name: 'claBlue'),
  310. (Value: TAlphaColors.BlueViolet; Name: 'claBlueViolet'),
  311. (Value: TAlphaColors.Brown; Name: 'claBrown'),
  312. (Value: TAlphaColors.BurlyWood; Name: 'claBurlyWood'),
  313. (Value: TAlphaColors.CadetBlue; Name: 'claCadetBlue'),
  314. (Value: TAlphaColors.Chartreuse; Name: 'claChartreuse'),
  315. (Value: TAlphaColors.Chocolate; Name: 'claChocolate'),
  316. (Value: TAlphaColors.Coral; Name: 'claCoral'),
  317. (Value: TAlphaColors.CornflowerBlue; Name: 'claCornflowerBlue'),
  318. (Value: TAlphaColors.CornSilk; Name: 'claCornSilk'),
  319. (Value: TAlphaColors.Cream; Name: 'claCream'),
  320. (Value: TAlphaColors.Crimson; Name: 'claCrimson'),
  321. (Value: TAlphaColors.Cyan; Name: 'claCyan'),
  322. (Value: TAlphaColors.DarkBlue; Name: 'claDarkBlue'),
  323. (Value: TAlphaColors.DarkCyan; Name: 'claDarkCyan'),
  324. (Value: TAlphaColors.DarkGoldenRod; Name: 'claDarkGoldenRod'),
  325. (Value: TAlphaColors.DarkGray; Name: 'claDarkGray'),
  326. (Value: TAlphaColors.DarkGreen; Name: 'claDarkGreen'),
  327. (Value: TAlphaColors.DarkGrey; Name: 'claDarkGrey'),
  328. (Value: TAlphaColors.DarkKhaki; Name: 'claDarkKhaki'),
  329. (Value: TAlphaColors.DarkMagenta; Name: 'claDarkMagenta'),
  330. (Value: TAlphaColors.DarkOliveGreen; Name: 'claDarkOliveGreen'),
  331. (Value: TAlphaColors.DarkOrange; Name: 'claDarkOrange'),
  332. (Value: TAlphaColors.DarkOrchid; Name: 'claDarkOrchid'),
  333. (Value: TAlphaColors.DarkRed; Name: 'claDarkRed'),
  334. (Value: TAlphaColors.DarkSalmon; Name: 'claDarkSalmon'),
  335. (Value: TAlphaColors.DarkSeaGreen; Name: 'claDarkSeaGreen'),
  336. (Value: TAlphaColors.DarkSlateBlue; Name: 'claDarkSlateBlue'),
  337. (Value: TAlphaColors.DarkSlateGray; Name: 'claDarkSlateGray'),
  338. (Value: TAlphaColors.DarkSlateGrey; Name: 'claDarkSlateGrey'),
  339. (Value: TAlphaColors.DarkTurquoise; Name: 'claDarkTurquoise'),
  340. (Value: TAlphaColors.DarkViolet; Name: 'claDarkViolet'),
  341. (Value: TAlphaColors.DeepPink; Name: 'claDeepPink'),
  342. (Value: TAlphaColors.DeepSkyBlue; Name: 'claDeepSkyBlue'),
  343. (Value: TAlphaColors.DimGray; Name: 'claDimGray'),
  344. (Value: TAlphaColors.DimGrey; Name: 'claDimGrey'),
  345. (Value: TAlphaColors.DkGray; Name: 'claDkGray'),
  346. (Value: TAlphaColors.DodgerBlue; Name: 'claDodgerBlue'),
  347. (Value: TAlphaColors.Firebrick; Name: 'claFirebrick'),
  348. (Value: TAlphaColors.FloralWhite; Name: 'claFloralWhite'),
  349. (Value: TAlphaColors.ForestGreen; Name: 'claForestGreen'),
  350. (Value: TAlphaColors.Fuchsia; Name: 'claFuchsia'),
  351. (Value: TAlphaColors.Gainsboro; Name: 'claGainsboro'),
  352. (Value: TAlphaColors.GhostWhite; Name: 'claGhostWhite'),
  353. (Value: TAlphaColors.GoldenRod; Name: 'claGoldenRod'),
  354. (Value: TAlphaColors.Gold; Name: 'claGold'),
  355. (Value: TAlphaColors.Gray; Name: 'claGray'),
  356. (Value: TAlphaColors.Green; Name: 'claGreen'),
  357. (Value: TAlphaColors.GreenYellow; Name: 'claGreenYellow'),
  358. (Value: TAlphaColors.Grey; Name: 'claGrey'),
  359. (Value: TAlphaColors.HoneyDew; Name: 'claHoneyDew'),
  360. (Value: TAlphaColors.HotPink; Name: 'claHotPink'),
  361. (Value: TAlphaColors.IndianRed; Name: 'claIndianRed'),
  362. (Value: TAlphaColors.Indigo; Name: 'claIndigo'),
  363. (Value: TAlphaColors.Ivory; Name: 'claIvory'),
  364. (Value: TAlphaColors.Khaki; Name: 'claKhaki'),
  365. (Value: TAlphaColors.LavenderBlush; Name: 'claLavenderBlush'),
  366. (Value: TAlphaColors.Lavender; Name: 'claLavender'),
  367. (Value: TAlphaColors.LawnGreen; Name: 'claLawnGreen'),
  368. (Value: TAlphaColors.LegacySkyBlue; Name: 'claLegacySkyBlue'),
  369. (Value: TAlphaColors.LemonChiffon; Name: 'claLemonChiffon'),
  370. (Value: TAlphaColors.LightBlue; Name: 'claLightBlue'),
  371. (Value: TAlphaColors.LightCoral; Name: 'claLightCoral'),
  372. (Value: TAlphaColors.LightCyan; Name: 'claLightCyan'),
  373. (Value: TAlphaColors.LightGoldenRodYellow; Name: 'claLightGoldenRodYellow'),
  374. (Value: TAlphaColors.LightGray; Name: 'claLightGray'),
  375. (Value: TAlphaColors.LightGreen; Name: 'claLightGreen'),
  376. (Value: TAlphaColors.LightGrey; Name: 'claLightGrey'),
  377. (Value: TAlphaColors.LightPink; Name: 'claLightPink'),
  378. (Value: TAlphaColors.LightSalmon; Name: 'claLightSalmon'),
  379. (Value: TAlphaColors.LightSeaGreen; Name: 'claLightSeaGreen'),
  380. (Value: TAlphaColors.LightSkyBlue; Name: 'claLightSkyBlue'),
  381. (Value: TAlphaColors.LightSlateGray; Name: 'claLightSlateGray'),
  382. (Value: TAlphaColors.LightSlateGrey; Name: 'claLightSlateGrey'),
  383. (Value: TAlphaColors.LightSteelBlue; Name: 'claLightSteelBlue'),
  384. (Value: TAlphaColors.LightYellow; Name: 'claLightYellow'),
  385. (Value: TAlphaColors.LimeGreen; Name: 'claLimeGreen'),
  386. (Value: TAlphaColors.Lime; Name: 'claLime'),
  387. (Value: TAlphaColors.Linen; Name: 'claLinen'),
  388. (Value: TAlphaColors.LtGray; Name: 'claLtGray'),
  389. (Value: TAlphaColors.Magenta; Name: 'claMagenta'),
  390. (Value: TAlphaColors.Maroon; Name: 'claMaroon'),
  391. (Value: TAlphaColors.MedGray; Name: 'claMedGray'),
  392. (Value: TAlphaColors.MediumAquaMarine; Name: 'claMediumAquaMarine'),
  393. (Value: TAlphaColors.MediumBlue; Name: 'claMediumBlue'),
  394. (Value: TAlphaColors.MediumOrchid; Name: 'claMediumOrchid'),
  395. (Value: TAlphaColors.MediumPurple; Name: 'claMediumPurple'),
  396. (Value: TAlphaColors.MediumSeaGreen; Name: 'claMediumSeaGreen'),
  397. (Value: TAlphaColors.MediumSlateBlue; Name: 'claMediumSlateBlue'),
  398. (Value: TAlphaColors.MediumSpringGreen; Name: 'claMediumSpringGreen'),
  399. (Value: TAlphaColors.MediumTurquoise; Name: 'claMediumTurquoise'),
  400. (Value: TAlphaColors.MediumVioletRed; Name: 'claMediumVioletRed'),
  401. (Value: TAlphaColors.MidnightBlue; Name: 'claMidnightBlue'),
  402. (Value: TAlphaColors.MintCream; Name: 'claMintCream'),
  403. (Value: TAlphaColors.MistyRose; Name: 'claMistyRose'),
  404. (Value: TAlphaColors.Moccasin; Name: 'claMoccasin'),
  405. (Value: TAlphaColors.MoneyGreen; Name: 'claMoneyGreen'),
  406. (Value: TAlphaColors.NavajoWhite; Name: 'claNavajoWhite'),
  407. (Value: TAlphaColors.Navy; Name: 'claNavy'),
  408. (Value: TAlphaColors.Null; Name: 'claNull'),
  409. (Value: TAlphaColors.OldLace; Name: 'claOldLace'),
  410. (Value: TAlphaColors.OliveDrab; Name: 'claOliveDrab'),
  411. (Value: TAlphaColors.Olive; Name: 'claOlive'),
  412. (Value: TAlphaColors.Orange; Name: 'claOrange'),
  413. (Value: TAlphaColors.OrangeRed; Name: 'claOrangeRed'),
  414. (Value: TAlphaColors.Orchid; Name: 'claOrchid'),
  415. (Value: TAlphaColors.PaleGoldenRod; Name: 'claPaleGoldenRod'),
  416. (Value: TAlphaColors.PaleGreen; Name: 'claPaleGreen'),
  417. (Value: TAlphaColors.PaleTurquoise; Name: 'claPaleTurquoise'),
  418. (Value: TAlphaColors.PaleVioletRed; Name: 'claPaleVioletRed'),
  419. (Value: TAlphaColors.PapayaWhip; Name: 'claPapayaWhip'),
  420. (Value: TAlphaColors.PeachPuff; Name: 'claPeachPuff'),
  421. (Value: TAlphaColors.Peru; Name: 'claPeru'),
  422. (Value: TAlphaColors.Pink; Name: 'claPink'),
  423. (Value: TAlphaColors.Plum; Name: 'claPlum'),
  424. (Value: TAlphaColors.PowderBlue; Name: 'claPowderBlue'),
  425. (Value: TAlphaColors.Purple; Name: 'claPurple'),
  426. (Value: TAlphaColors.Red; Name: 'claRed'),
  427. (Value: TAlphaColors.RosyBrown; Name: 'claRosyBrown'),
  428. (Value: TAlphaColors.RoyalBlue; Name: 'claRoyalBlue'),
  429. (Value: TAlphaColors.SaddleBrown; Name: 'claSaddleBrown'),
  430. (Value: TAlphaColors.Salmon; Name: 'claSalmon'),
  431. (Value: TAlphaColors.SandyBrown; Name: 'claSandyBrown'),
  432. (Value: TAlphaColors.SeaGreen; Name: 'claSeaGreen'),
  433. (Value: TAlphaColors.SeaShell; Name: 'claSeaShell'),
  434. (Value: TAlphaColors.Sienna; Name: 'claSienna'),
  435. (Value: TAlphaColors.Silver; Name: 'claSilver'),
  436. (Value: TAlphaColors.SkyBlue; Name: 'claSkyBlue'),
  437. (Value: TAlphaColors.SlateBlue; Name: 'claSlateBlue'),
  438. (Value: TAlphaColors.SlateGray; Name: 'claSlateGray'),
  439. (Value: TAlphaColors.SlateGrey; Name: 'claSlateGrey'),
  440. (Value: TAlphaColors.Snow; Name: 'claSnow'),
  441. (Value: TAlphaColors.SpringGreen; Name: 'claSpringGreen'),
  442. (Value: TAlphaColors.SteelBlue; Name: 'claSteelBlue'),
  443. (Value: TAlphaColors.Tan; Name: 'claTan'),
  444. (Value: TAlphaColors.Teal; Name: 'claTeal'),
  445. (Value: TAlphaColors.Thistle; Name: 'claThistle'),
  446. (Value: TAlphaColors.Tomato; Name: 'claTomato'),
  447. (Value: TAlphaColors.Turquoise; Name: 'claTurquoise'),
  448. (Value: TAlphaColors.Violet; Name: 'claViolet'),
  449. (Value: TAlphaColors.Wheat; Name: 'claWheat'),
  450. (Value: TAlphaColors.White; Name: 'claWhite'),
  451. (Value: TAlphaColors.WhiteSmoke; Name: 'claWhiteSmoke'),
  452. (Value: TAlphaColors.YellowGreen; Name: 'claYellowGreen'),
  453. (Value: TAlphaColors.Yellow; Name: 'claYellow')
  454. );
  455. implementation
  456. {$IFDEF FPC_DOTTEDUNITS}
  457. uses System.SysUtils;
  458. {$ELSE}
  459. uses SysUtils;
  460. {$ENDIF}
  461. { ****************************************************************************
  462. Colors
  463. ****************************************************************************}
  464. function ColorToIdent(Color: LongInt;var Ident: string): Boolean;
  465. begin
  466. Result:=IntToIdent(Color,Ident,ColorNames);
  467. end;
  468. function IdentToColor(const Ident: string;var Color: LongInt): Boolean;
  469. begin
  470. Result:=IdentToInt(Ident,Color,ColorNames);
  471. end;
  472. function ColorToString(Color: TColor): string;
  473. begin
  474. if ColorToIdent(Color,Result) then
  475. exit;
  476. Result:=Format('$%0.8x',[Integer(Color)]);
  477. end;
  478. function StringToColor(const S: string): TColor;
  479. begin
  480. if IdentToColor(S,LongInt(Result)) then
  481. exit;
  482. Result:=TColor(StrToIntDef(S,Integer(TColorRec.Black)));
  483. end;
  484. procedure GetColorValues(Proc: TGetStrProc);
  485. var
  486. C: Integer;
  487. begin
  488. for C:=Low(ColorNames) to High(ColorNames) do
  489. Proc(ColorNames[C].Name);
  490. end;
  491. procedure RegisterColorIntegerConsts;
  492. begin
  493. if Assigned(FindIntToIdent(TypeInfo(TColor))) then
  494. exit;
  495. RegisterIntegerConsts(TypeInfo(TColor),@IdentToColor,@ColorToIdent);
  496. end;
  497. { ****************************************************************************
  498. AlphaColors
  499. ****************************************************************************}
  500. function AlphaColorToIdent(Color: LongInt; var Ident: string): Boolean;
  501. begin
  502. Result:=IntToIdent(Color,Ident,AlphaColorNames);
  503. if not Result then
  504. begin
  505. Ident:='x'+IntToHex(Color,8);
  506. Result:=True;
  507. end;
  508. end;
  509. function IdentToAlphaColor(const Ident: string; var Color: LongInt): Boolean;
  510. var
  511. S: string;
  512. begin
  513. S:=Ident;
  514. Result:=(Length(S)>1) and (S[1]='x');
  515. if Result then
  516. Color:=Integer(StringToAlphaColor(S))
  517. else
  518. begin
  519. Result:=IdentToInt(S,Color,AlphaColorNames);
  520. if not Result and (Length(S)>2) and (S[1]='c') and (S[2]='l') then
  521. begin
  522. Insert('a',S,3);
  523. Result:=IdentToInt(S,Color,AlphaColorNames);
  524. end;
  525. end;
  526. end;
  527. procedure GetAlphaColorValues(Proc: TGetStrProc);
  528. var
  529. AC: Integer;
  530. begin
  531. for AC:=Low(AlphaColorNames) to High(AlphaColorNames) do
  532. Proc(Copy(AlphaColorNames[AC].Name,4));
  533. end;
  534. function AlphaColorToString(Value: TAlphaColor): string;
  535. begin
  536. Result:='';
  537. if AlphaColorToIdent(Integer(Value),Result) then
  538. begin
  539. if Result[1]='x' then
  540. Result[1]:='#'
  541. else
  542. Delete(Result,1,3); // Strip cla...
  543. end;
  544. end;
  545. function StringToAlphaColor(const Value: string): TAlphaColor;
  546. var
  547. S: string;
  548. begin
  549. S:=Value;
  550. if (S=#0) or (S='') then
  551. Result:=TAlphaColors.Black
  552. else if (Length(S)>0) and (S[1] in ['#','x']) then
  553. begin
  554. S:='$'+Copy(S,2);
  555. Result:=TAlphaColor(StrToIntDef(S,TAlphaColors.Black));
  556. end
  557. else
  558. if not IdentToAlphaColor(S,LongInt(Result)) then
  559. if not IdentToAlphaColor('cla'+S,LongInt(Result)) then
  560. Result:=TAlphaColor(StrToIntDef(S,TAlphaColors.Black));
  561. end;
  562. procedure RegisterAlphaColorIntegerConsts;
  563. begin
  564. if not Assigned(FindIntToIdent(TypeInfo(TAlphaColor))) then
  565. RegisterIntegerConsts(TypeInfo(TAlphaColor),@IdentToAlphaColor,@AlphaColorToIdent);
  566. end;
  567. function AlphaColorToColor(const Color: TAlphaColor): TColor;
  568. Var
  569. R : TColorRec;
  570. begin
  571. R.A:=0;
  572. R.R:=TAlphaColorRec(Color).R;
  573. R.G:=TAlphaColorRec(Color).G;
  574. R.B:=TAlphaColorRec(Color).B;
  575. Result:=TColor(R);
  576. end;
  577. function AppendColor(Start, Stop: TAlphaColor): TAlphaColor;
  578. function Channel(aStart,aStop : Byte) : byte;
  579. var
  580. R : Integer;
  581. begin
  582. Result:=MaxColorChannel;
  583. R:=aStart+aStop;
  584. if R<Result then
  585. Result:=R;
  586. end;
  587. var
  588. RSA : TAlphaColorRec absolute start;
  589. RSS : TAlphaColorRec absolute stop;
  590. R : TAlphaColorRec;
  591. begin
  592. R.A:=Channel(RSA.A,RSS.A);
  593. R.R:=Channel(RSA.R,RSS.R);
  594. R.G:=Channel(RSA.G,RSS.G);
  595. R.B:=Channel(RSA.B,RSS.B);
  596. Result:=TAlphaColor(R);
  597. end;
  598. function SubtractColor(Start, Stop: TAlphaColor): TAlphaColor;
  599. function Channel(aStart,aStop : Byte) : byte;
  600. var
  601. R : Integer;
  602. begin
  603. Result:=MaxColorChannel;
  604. R:=aStart-aStop;
  605. if R>=0 then
  606. Result:=R;
  607. end;
  608. var
  609. RSA : TAlphaColorRec absolute start;
  610. RSS : TAlphaColorRec absolute stop;
  611. R : TAlphaColorRec absolute Result;
  612. begin
  613. R.A:=Channel(RSA.A,RSS.A);
  614. R.R:=Channel(RSA.R,RSS.R);
  615. R.G:=Channel(RSA.G,RSS.G);
  616. R.B:=Channel(RSA.B,RSS.B);
  617. end;
  618. function RGBtoBGR(const C: TAlphaColor): TAlphaColor;
  619. Var
  620. R : TAlphaColorRec absolute result;
  621. CR : TAlphaColorRec absolute c;
  622. begin
  623. Result:=C;
  624. R.R:=CR.B;
  625. R.B:=CR.R;
  626. end;
  627. function CorrectColor(const C: TAlphaColor): TAlphaColor;
  628. begin
  629. {$IFNDEF WINDOWS}
  630. Result:=RGBtoBGR(C);
  631. {$ELSE}
  632. Result:=C;
  633. {$ENDIF}
  634. end;
  635. function PremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
  636. Function Mul(C,A : Byte) : Byte; inline;
  637. begin
  638. Result:=Trunc(C*A/MaxColorChannel);
  639. end;
  640. var
  641. CR : TAlphaColorRec absolute C;
  642. R : TAlphaColorRec absolute Result;
  643. begin
  644. if CR.A=0 then
  645. Result:=0
  646. else if CR.A=MaxColorChannel then
  647. Result:=C
  648. else
  649. begin
  650. R.A:=CR.A;
  651. R.R:=Mul(CR.R,CR.A);
  652. R.G:=Mul(CR.G,CR.A);
  653. R.B:=Mul(CR.B,CR.A);
  654. end;
  655. end;
  656. function UnpremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
  657. Function CDiv(C,A : Byte) : Byte; inline;
  658. begin
  659. Result:=Trunc(C/A/MaxColorChannel);
  660. end;
  661. var
  662. CR : TAlphaColorRec absolute C;
  663. R : TAlphaColorRec absolute Result;
  664. begin
  665. if CR.A=0 then
  666. Result:=0
  667. else if CR.A=MaxColorChannel then
  668. Result:=C
  669. else
  670. begin
  671. R.A:=CR.A;
  672. R.R:=CDiv(CR.R,CR.A);
  673. R.G:=CDiv(CR.G,CR.A);
  674. R.B:=CDiv(CR.B,CR.A);
  675. end;
  676. end;
  677. function MakeColor(const C: TAlphaColor; const AOpacity: Single): TAlphaColor;
  678. var
  679. CR : TAlphaColorRec absolute C;
  680. R : TAlphaColorRec absolute Result;
  681. begin
  682. Result:=C;
  683. if AOpacity<1 then
  684. R.A:=trunc(CR.A*AOpacity);
  685. end;
  686. function MakeColor(R, G, B: Byte; A: Byte = MaxColorChannel): TAlphaColor;
  687. var
  688. RC : TAlphaColorRec absolute Result;
  689. begin
  690. RC.A:=A;
  691. RC.R:=R;
  692. RC.G:=G;
  693. RC.B:=B;
  694. end;
  695. function LimitRange01(v : single):single;inline;
  696. begin
  697. if V<0 then
  698. V:=0
  699. else if V>1 then
  700. V:=1;
  701. Result:=V;
  702. end;
  703. // Only valid for -1<=V<=2
  704. function ToRange01(v : single):single;inline;
  705. begin
  706. if V<0 then
  707. V:=V+1
  708. else if V>1 then
  709. V:=V-1;
  710. Result:=V;
  711. end;
  712. function Max(A,B: Single):Single;inline;
  713. begin
  714. if (A>B) then Result:=A else Result:=B;
  715. end;
  716. function Min(A,B: Single):Single;inline;
  717. begin
  718. if (A<B) then Result:=A else Result:=B;
  719. end;
  720. function ChangeHSL(const C: TAlphaColor; dH, dS, dL: Single): TAlphaColor;
  721. var
  722. H,S,L: Single;
  723. CR : TAlphaColorRec absolute C;
  724. R : TAlphaColorRec absolute Result;
  725. begin
  726. RGBtoHSL(C,H,S,L);
  727. H:=ToRange01(H+dH);
  728. S:=LimitRange01(S+dS);
  729. L:=LimitRange01(S+dL);
  730. Result:=HSLtoRGB(H,S,L);
  731. R.A:=CR.A;
  732. end;
  733. function Hue2RGBChannel(P,Q,T: Single): Single;
  734. begin
  735. T:=ToRange01(T);
  736. if (t<1/6) then
  737. Exit(P+(Q-P)*6*t);
  738. if (t<1/2) then
  739. Exit(Q);
  740. if (t<2/3) then
  741. Exit(P+(Q-P)*(2/3-t)*6);
  742. Result:=LimitRange01(P);
  743. end;
  744. // Adapted from https://www.delphipraxis.net/157099-fast-integer-rgb-hsl.html
  745. function HSLtoRGB(H, S, L: Single): TAlphaColor;
  746. const
  747. Fact = 1/3;
  748. Function UpScale(S : Single) : Byte; inline;
  749. begin
  750. Result:=round(S*MaxColorChannel);
  751. end;
  752. var
  753. R, G, B: Single;
  754. Q, P: Single;
  755. begin
  756. if (S = 0) then
  757. begin
  758. L:=LimitRange01(L);
  759. R:=L;
  760. G:=L;
  761. B:=L;
  762. end
  763. else
  764. begin
  765. if (L < 0.5) then
  766. Q:=L*(1+S)
  767. else
  768. Q:=L+S*(1-L);
  769. P:=2*L-q;
  770. G:=Hue2RGBChannel(P,Q,H);
  771. B:=Hue2RGBChannel(P,Q,H-Fact);
  772. R:=Hue2RGBChannel(P,Q,H+Fact);
  773. end;
  774. Result:=MakeColor(UpScale(R),UpScale(G),UpScale(B));
  775. end;
  776. procedure RGBtoHSL(RGB: TAlphaColor; out H, S, L: Single);
  777. var
  778. R,G,B,MA,MI,Su,Diff: Single;
  779. RGBR : TAlphaColorRec absolute RGB;
  780. begin
  781. R:=RGBR.R/$FF;
  782. G:=RGBR.G/$FF;
  783. B:=RGBR.B/$FF;
  784. MA:=Max(Max(R,G),B);
  785. MI:=Min(Min(R,G),B);
  786. Su:=(MI+MA);
  787. H:=Su/2;
  788. L:=H;
  789. if (MI=MA) then
  790. begin
  791. S:=0;
  792. H:=0;
  793. end
  794. else
  795. begin
  796. S:=H;
  797. Diff:=MA-MI;
  798. if L<=0.5 then
  799. S:=Diff/Su
  800. else
  801. S:=Diff/(2-Su);
  802. if (MA=R) then
  803. H:=(G-B)/Diff
  804. else if (MA=G) then
  805. H:=((B-R)/Diff)+2
  806. else
  807. H:=((R-G)/Diff)+4;
  808. H:=H/6;
  809. if H<0 then
  810. H:=H+1;
  811. end;
  812. end;
  813. function AlphaColorToIntColor(Color: TAlphaColor): Longint;
  814. begin
  815. Result:=AlphaColorToColor(Color);
  816. end;
  817. { ****************************************************************************
  818. Cursors
  819. ****************************************************************************}
  820. procedure RegisterCursorIntegerConsts;
  821. begin
  822. if Assigned(FindIntToIdent(TypeInfo(TCursor))) then
  823. exit;
  824. RegisterIntegerConsts(TypeInfo(TCursor),@IdentToCursor,@CursorToIdent);
  825. end;
  826. function CursorToIdent(Cursor: LongInt;var Ident: string): Boolean;
  827. begin
  828. Result:=IntToIdent(Cursor,Ident,CursorNames);
  829. end;
  830. function IdentToCursor(const Ident: string;var Cursor: LongInt): Boolean;
  831. begin
  832. Result:=IdentToInt(Ident, Cursor, CursorNames);
  833. end;
  834. function CursorToString(Cursor: TCursor): string;
  835. begin
  836. if CursorToIdent(Cursor,Result) then
  837. exit;
  838. Result:=Format('%d',[Cursor]);
  839. end;
  840. function StringToCursor(const S: string): TCursor;
  841. var
  842. C : Longint;
  843. begin
  844. if IdentToCursor(S,C) then
  845. Exit(TCursor(C));
  846. Result:=StrToIntDef(S, Integer(crDefault));
  847. end;
  848. procedure GetCursorValues(const Proc: TGetStrProc);
  849. var
  850. C: Integer;
  851. begin
  852. // Last 2 are duplicates
  853. for C:=Low(CursorNames) to High(CursorNames)-2 do
  854. Proc(CursorNames[C].Name);
  855. end;
  856. initialization
  857. System.UITypes.TAlphaColorRec.ColorToRGB:=@AlphaColorToIntColor;
  858. end.