unit System.UIConsts;
{
This file is part of the Free Pascal run time library.
Copyright (c) 2023 the Free Pascal development team
FPC/Lazarus Replacement for UIConsts from Delphi 10.x
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$MODE OBJFPC}
{$H+}
{$R-}
interface
{$IFDEF FPC_DOTTEDUNITS}
uses System.UITypes, System.Classes;
{$ELSE}
uses System.UITypes, Classes;
{$ENDIF}
const
MaxColorChannel = $FF;
const
claAliceblue = TAlphaColors.AliceBlue;
claAntiquewhite = TAlphaColors.Antiquewhite;
claAqua = TAlphaColors.Aqua;
claAquamarine = TAlphaColors.Aquamarine;
claAzure = TAlphaColors.Azure;
claBeige = TAlphaColors.Beige;
claBisque = TAlphaColors.Bisque;
claBlack = TAlphaColors.Black;
claBlanchedalmond = TAlphaColors.Blanchedalmond;
claBlue = TAlphaColors.Blue;
claBlueviolet = TAlphaColors.Blueviolet;
claBrown = TAlphaColors.Brown;
claBurlywood = TAlphaColors.Burlywood;
claCadetblue = TAlphaColors.Cadetblue;
claChartreuse = TAlphaColors.Chartreuse;
claChocolate = TAlphaColors.Chocolate;
claCoral = TAlphaColors.Coral;
claCornflowerblue = TAlphaColors.Cornflowerblue;
claCornsilk = TAlphaColors.Cornsilk;
claCrimson = TAlphaColors.Crimson;
claCyan = TAlphaColors.Cyan;
claDarkblue = TAlphaColors.Darkblue;
claDarkcyan = TAlphaColors.Darkcyan;
claDarkgoldenrod = TAlphaColors.Darkgoldenrod;
claDarkgray = TAlphaColors.Darkgray;
claDarkgreen = TAlphaColors.Darkgreen;
claDarkgrey = TAlphaColors.Darkgrey;
claDarkkhaki = TAlphaColors.Darkkhaki;
claDarkmagenta = TAlphaColors.Darkmagenta;
claDarkolivegreen = TAlphaColors.Darkolivegreen;
claDarkorange = TAlphaColors.Darkorange;
claDarkorchid = TAlphaColors.Darkorchid;
claDarkred = TAlphaColors.Darkred;
claDarksalmon = TAlphaColors.Darksalmon;
claDarkseagreen = TAlphaColors.Darkseagreen;
claDarkslateblue = TAlphaColors.Darkslateblue;
claDarkslategray = TAlphaColors.Darkslategray;
claDarkslategrey = TAlphaColors.Darkslategrey;
claDarkturquoise = TAlphaColors.Darkturquoise;
claDarkviolet = TAlphaColors.Darkviolet;
claDeeppink = TAlphaColors.Deeppink;
claDeepskyblue = TAlphaColors.Deepskyblue;
claDimgray = TAlphaColors.Dimgray;
claDimgrey = TAlphaColors.Dimgrey;
claDodgerblue = TAlphaColors.Dodgerblue;
claFirebrick = TAlphaColors.Firebrick;
claFloralwhite = TAlphaColors.Floralwhite;
claForestgreen = TAlphaColors.Forestgreen;
claFuchsia = TAlphaColors.Fuchsia;
claGainsboro = TAlphaColors.Gainsboro;
claGhostwhite = TAlphaColors.Ghostwhite;
claGold = TAlphaColors.Gold;
claGoldenrod = TAlphaColors.Goldenrod;
claGray = TAlphaColors.Gray;
claGreen = TAlphaColors.Green;
claGreenyellow = TAlphaColors.Greenyellow;
claGrey = TAlphaColors.Grey;
claHoneydew = TAlphaColors.Honeydew;
claHotpink = TAlphaColors.Hotpink;
claIndianred = TAlphaColors.Indianred;
claIndigo = TAlphaColors.Indigo;
claIvory = TAlphaColors.Ivory;
claKhaki = TAlphaColors.Khaki;
claLavender = TAlphaColors.Lavender;
claLavenderblush = TAlphaColors.Lavenderblush;
claLawngreen = TAlphaColors.Lawngreen;
claLemonchiffon = TAlphaColors.Lemonchiffon;
claLightblue = TAlphaColors.Lightblue;
claLightcoral = TAlphaColors.Lightcoral;
claLightcyan = TAlphaColors.Lightcyan;
claLightgoldenrodyellow = TAlphaColors.Lightgoldenrodyellow;
claLightgray = TAlphaColors.Lightgray;
claLightgreen = TAlphaColors.Lightgreen;
claLightgrey = TAlphaColors.Lightgrey;
claLightpink = TAlphaColors.Lightpink;
claLightsalmon = TAlphaColors.Lightsalmon;
claLightseagreen = TAlphaColors.Lightseagreen;
claLightskyblue = TAlphaColors.Lightskyblue;
claLightslategray = TAlphaColors.Lightslategray;
claLightslategrey = TAlphaColors.Lightslategrey;
claLightsteelblue = TAlphaColors.Lightsteelblue;
claLightyellow = TAlphaColors.Lightyellow;
claLime = TAlphaColors.Lime;
claLimegreen = TAlphaColors.Limegreen;
claLinen = TAlphaColors.Linen;
claMagenta = TAlphaColors.Magenta;
claMaroon = TAlphaColors.Maroon;
claMediumaquamarine = TAlphaColors.Mediumaquamarine;
claMediumblue = TAlphaColors.Mediumblue;
claMediumorchid = TAlphaColors.Mediumorchid;
claMediumpurple = TAlphaColors.Mediumpurple;
claMediumseagreen = TAlphaColors.Mediumseagreen;
claMediumslateblue = TAlphaColors.Mediumslateblue;
claMediumspringgreen = TAlphaColors.Mediumspringgreen;
claMediumturquoise = TAlphaColors.Mediumturquoise;
claMediumvioletred = TAlphaColors.Mediumvioletred;
claMidnightblue = TAlphaColors.Midnightblue;
claMintcream = TAlphaColors.Mintcream;
claMistyrose = TAlphaColors.Mistyrose;
claMoccasin = TAlphaColors.Moccasin;
claNavajowhite = TAlphaColors.Navajowhite;
claNavy = TAlphaColors.Navy;
claOldlace = TAlphaColors.Oldlace;
claOlive = TAlphaColors.Olive;
claOlivedrab = TAlphaColors.Olivedrab;
claOrange = TAlphaColors.Orange;
claOrangered = TAlphaColors.Orangered;
claOrchid = TAlphaColors.Orchid;
claPalegoldenrod = TAlphaColors.Palegoldenrod;
claPalegreen = TAlphaColors.Palegreen;
claPaleturquoise = TAlphaColors.Paleturquoise;
claPalevioletred = TAlphaColors.Palevioletred;
claPapayawhip = TAlphaColors.Papayawhip;
claPeachpuff = TAlphaColors.Peachpuff;
claPeru = TAlphaColors.Peru;
claPink = TAlphaColors.Pink;
claPlum = TAlphaColors.Plum;
claPowderblue = TAlphaColors.Powderblue;
claPurple = TAlphaColors.Purple;
claRed = TAlphaColors.Red;
claRosybrown = TAlphaColors.Rosybrown;
claRoyalblue = TAlphaColors.Royalblue;
claSaddlebrown = TAlphaColors.Saddlebrown;
claSalmon = TAlphaColors.Salmon;
claSandybrown = TAlphaColors.Sandybrown;
claSeagreen = TAlphaColors.Seagreen;
claSeashell = TAlphaColors.Seashell;
claSienna = TAlphaColors.Sienna;
claSilver = TAlphaColors.Silver;
claSkyblue = TAlphaColors.Skyblue;
claSlateblue = TAlphaColors.Slateblue;
claSlategray = TAlphaColors.Slategray;
claSlategrey = TAlphaColors.Slategrey;
claSnow = TAlphaColors.Snow;
claSpringgreen = TAlphaColors.Springgreen;
claSteelblue = TAlphaColors.Steelblue;
claTan = TAlphaColors.Tan;
claTeal = TAlphaColors.Teal;
claThistle = TAlphaColors.Thistle;
claTomato = TAlphaColors.Tomato;
claTurquoise = TAlphaColors.Turquoise;
claViolet = TAlphaColors.Violet;
claWheat = TAlphaColors.Wheat;
claWhite = TAlphaColors.White;
claWhitesmoke = TAlphaColors.Whitesmoke;
claYellow = TAlphaColors.Yellow;
claYellowgreen = TAlphaColors.Yellowgreen;
claNull = TAlphaColors.Null;
{ Cursor string functions }
function CursorToString(Cursor: TCursor): string;
function StringToCursor(const S: string): TCursor;
procedure GetCursorValues(const Proc: TGetStrProc);
function CursorToIdent(Cursor: LongInt; var Ident: string): Boolean; inline;
function IdentToCursor(const Ident: string; var Cursor: LongInt): Boolean; inline;
procedure RegisterCursorIntegerConsts;
{ TColor string functions }
function ColorToString(Color: TColor): string;
function StringToColor(const S: string): TColor;
procedure GetColorValues(Proc: TGetStrProc);
function ColorToIdent(Color: Longint; var Ident: string): Boolean; inline;
function IdentToColor(const Ident: string; var Color: LongInt): Boolean; inline;
procedure RegisterColorIntegerConsts;
{ TAlphaColor string functions }
procedure GetAlphaColorValues(Proc: TGetStrProc);
function AlphaColorToString(Value: TAlphaColor): string;
function StringToAlphaColor(const Value: string): TAlphaColor;
function AlphaColorToIdent(Color: LongInt; var Ident: string): Boolean;
function IdentToAlphaColor(const Ident: string; var Color: Longint): Boolean;
procedure RegisterAlphaColorIntegerConsts;
{ TAlphaColor function's }
/// Converts TAlphaColor into TColor structure, exchanging red and blue channels while losing alpha channel.
function AlphaColorToColor(const Color: TAlphaColor): TColor;
function AppendColor(Start, Stop: TAlphaColor): TAlphaColor;
function SubtractColor(Start, Stop: TAlphaColor): TAlphaColor;
function RGBtoBGR(const C: TAlphaColor): TAlphaColor;
function CorrectColor(const C: TAlphaColor): TAlphaColor;
function PremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
function UnpremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
function MakeColor(R, G, B: Byte; A: Byte = MaxColorChannel): TAlphaColor; overload;
function MakeColor(const C: TAlphaColor; const AOpacity: Single): TAlphaColor; overload;
function HSLtoRGB(H, S, L: Single): TAlphaColor;
procedure RGBtoHSL(RGB: TAlphaColor; out H, S, L: Single);
function ChangeHSL(const C: TAlphaColor; dH, dS, dL: Single): TAlphaColor;
const
// Please keep these sorted.
CursorNames: array[0..30] of TIdentMapEntry = (
(Value: crAppStart; Name: 'crAppStart'),
(Value: crArrow; Name: 'crArrow'),
(Value: crCross; Name: 'crCross'),
(Value: crDefault; Name: 'crDefault'),
(Value: crDrag; Name: 'crDrag'),
(Value: crHandPoint; Name: 'crHandPoint'),
(Value: crHelp; Name: 'crHelp'),
(Value: crHourGlass; Name: 'crHourGlass'),
(Value: crHSplit; Name: 'crHSplit'),
(Value: crIBeam; Name: 'crIBeam'),
(Value: crMultiDrag; Name: 'crMultiDrag'),
(Value: crNoDrop; Name: 'crNoDrop'),
(Value: crNo; Name: 'crNo'),
(Value: crSizeAll; Name: 'crSizeAll'),
(Value: crSizeE; Name: 'crSizeE'),
(Value: crSizeNE; Name: 'crSizeNE'),
(Value: crSizeNESW; Name: 'crSizeNESW'),
(Value: crSizeN; Name: 'crSizeN'),
(Value: crSizeNS; Name: 'crSizeNS'),
(Value: crSizeNW; Name: 'crSizeNW'),
(Value: crSizeNWSE; Name: 'crSizeNWSE'),
(Value: crSizeSE; Name: 'crSizeSE'),
(Value: crSizeS; Name: 'crSizeS'),
(Value: crSizeSW; Name: 'crSizeSW'),
(Value: crSizeWE; Name: 'crSizeWE'),
(Value: crSizeW; Name: 'crSizeW'),
(Value: crSQLWait; Name: 'crSQLWait'),
(Value: crUpArrow; Name: 'crUpArrow'),
(Value: crVSplit; Name: 'crVSplit'),
// These must be last, duplicates!
(Value: crSize; Name: 'crSize'),
(Value: crLow; Name: 'crLow')
);
// Please keep these sorted.
ColorNames: array[0..51] of TIdentMapEntry = (
(Value: TColors.Aqua; Name: 'clAqua'),
(Value: TColors.Black; Name: 'clBlack'),
(Value: TColors.Blue; Name: 'clBlue'),
(Value: TColors.Cream; Name: 'clCream'),
(Value: TColors.Fuchsia; Name: 'clFuchsia'),
(Value: TColors.Gray; Name: 'clGray'),
(Value: TColors.Green; Name: 'clGreen'),
(Value: TColors.Lime; Name: 'clLime'),
(Value: TColors.Maroon; Name: 'clMaroon'),
(Value: TColors.MedGray; Name: 'clMedGray'),
(Value: TColors.MoneyGreen; Name: 'clMoneyGreen'),
(Value: TColors.Navy; Name: 'clNavy'),
(Value: TColors.Olive; Name: 'clOlive'),
(Value: TColors.Purple; Name: 'clPurple'),
(Value: TColors.Red; Name: 'clRed'),
(Value: TColors.Silver; Name: 'clSilver'),
(Value: TColors.SkyBlue; Name: 'clSkyBlue'),
(Value: TColors.Sys3DDkShadow; Name: 'cl3DDkShadow'),
(Value: TColors.Sys3DLight; Name: 'cl3DLight'),
(Value: TColors.SysActiveBorder; Name: 'clActiveBorder'),
(Value: TColors.SysActiveCaption; Name: 'clActiveCaption'),
(Value: TColors.SysAppWorkSpace; Name: 'clAppWorkSpace'),
(Value: TColors.SysBackground; Name: 'clBackground'),
(Value: TColors.SysBtnFace; Name: 'clBtnFace'),
(Value: TColors.SysBtnHighlight; Name: 'clBtnHighlight'),
(Value: TColors.SysBtnShadow; Name: 'clBtnShadow'),
(Value: TColors.SysBtnText; Name: 'clBtnText'),
(Value: TColors.SysCaptionText; Name: 'clCaptionText'),
(Value: TColors.SysDefault; Name: 'clDefault'),
(Value: TColors.SysGradientActiveCaption; Name: 'clGradientActiveCaption'),
(Value: TColors.SysGradientInactiveCaption; Name: 'clGradientInactiveCaption'),
(Value: TColors.SysGrayText; Name: 'clGrayText'),
(Value: TColors.SysHighlight; Name: 'clHighlight'),
(Value: TColors.SysHighlightText; Name: 'clHighlightText'),
(Value: TColors.SysHotLight; Name: 'clHotLight'),
(Value: TColors.SysInactiveBorder; Name: 'clInactiveBorder'),
(Value: TColors.SysInactiveCaption; Name: 'clInactiveCaption'),
(Value: TColors.SysInactiveCaptionText; Name: 'clInactiveCaptionText'),
(Value: TColors.SysInfoBk; Name: 'clInfoBk'),
(Value: TColors.SysInfoText; Name: 'clInfoText'),
(Value: TColors.SysMenuBar; Name: 'clMenuBar'),
(Value: TColors.SysMenuHighlight; Name: 'clMenuHighlight'),
(Value: TColors.SysMenu; Name: 'clMenu'),
(Value: TColors.SysMenuText; Name: 'clMenuText'),
(Value: TColors.SysNone; Name: 'clNone'),
(Value: TColors.SysScrollBar; Name: 'clScrollBar'),
(Value: TColors.SysWindowFrame; Name: 'clWindowFrame'),
(Value: TColors.SysWindow; Name: 'clWindow'),
(Value: TColors.SysWindowText; Name: 'clWindowText'),
(Value: TColors.Teal; Name: 'clTeal'),
(Value: TColors.White; Name: 'clWhite'),
(Value: TColors.Yellow; Name: 'clYellow')
);
AlphaColorNames: array [0..154] of TIdentMapEntry = (
(Value: TAlphaColors.AliceBlue; Name: 'claAliceBlue'),
(Value: TAlphaColors.Alpha; Name: 'claAlpha'),
(Value: TAlphaColors.AntiqueWhite; Name: 'claAntiqueWhite'),
(Value: TAlphaColors.AquaMarine; Name: 'claAquaMarine'),
(Value: TAlphaColors.Aqua; Name: 'claAqua'),
(Value: TAlphaColors.Azure; Name: 'claAzure'),
(Value: TAlphaColors.Beige; Name: 'claBeige'),
(Value: TAlphaColors.Bisque; Name: 'claBisque'),
(Value: TAlphaColors.Black; Name: 'claBlack'),
(Value: TAlphaColors.BlanchedAlmond; Name: 'claBlanchedAlmond'),
(Value: TAlphaColors.Blue; Name: 'claBlue'),
(Value: TAlphaColors.BlueViolet; Name: 'claBlueViolet'),
(Value: TAlphaColors.Brown; Name: 'claBrown'),
(Value: TAlphaColors.BurlyWood; Name: 'claBurlyWood'),
(Value: TAlphaColors.CadetBlue; Name: 'claCadetBlue'),
(Value: TAlphaColors.Chartreuse; Name: 'claChartreuse'),
(Value: TAlphaColors.Chocolate; Name: 'claChocolate'),
(Value: TAlphaColors.Coral; Name: 'claCoral'),
(Value: TAlphaColors.CornflowerBlue; Name: 'claCornflowerBlue'),
(Value: TAlphaColors.CornSilk; Name: 'claCornSilk'),
(Value: TAlphaColors.Cream; Name: 'claCream'),
(Value: TAlphaColors.Crimson; Name: 'claCrimson'),
(Value: TAlphaColors.Cyan; Name: 'claCyan'),
(Value: TAlphaColors.DarkBlue; Name: 'claDarkBlue'),
(Value: TAlphaColors.DarkCyan; Name: 'claDarkCyan'),
(Value: TAlphaColors.DarkGoldenRod; Name: 'claDarkGoldenRod'),
(Value: TAlphaColors.DarkGray; Name: 'claDarkGray'),
(Value: TAlphaColors.DarkGreen; Name: 'claDarkGreen'),
(Value: TAlphaColors.DarkGrey; Name: 'claDarkGrey'),
(Value: TAlphaColors.DarkKhaki; Name: 'claDarkKhaki'),
(Value: TAlphaColors.DarkMagenta; Name: 'claDarkMagenta'),
(Value: TAlphaColors.DarkOliveGreen; Name: 'claDarkOliveGreen'),
(Value: TAlphaColors.DarkOrange; Name: 'claDarkOrange'),
(Value: TAlphaColors.DarkOrchid; Name: 'claDarkOrchid'),
(Value: TAlphaColors.DarkRed; Name: 'claDarkRed'),
(Value: TAlphaColors.DarkSalmon; Name: 'claDarkSalmon'),
(Value: TAlphaColors.DarkSeaGreen; Name: 'claDarkSeaGreen'),
(Value: TAlphaColors.DarkSlateBlue; Name: 'claDarkSlateBlue'),
(Value: TAlphaColors.DarkSlateGray; Name: 'claDarkSlateGray'),
(Value: TAlphaColors.DarkSlateGrey; Name: 'claDarkSlateGrey'),
(Value: TAlphaColors.DarkTurquoise; Name: 'claDarkTurquoise'),
(Value: TAlphaColors.DarkViolet; Name: 'claDarkViolet'),
(Value: TAlphaColors.DeepPink; Name: 'claDeepPink'),
(Value: TAlphaColors.DeepSkyBlue; Name: 'claDeepSkyBlue'),
(Value: TAlphaColors.DimGray; Name: 'claDimGray'),
(Value: TAlphaColors.DimGrey; Name: 'claDimGrey'),
(Value: TAlphaColors.DkGray; Name: 'claDkGray'),
(Value: TAlphaColors.DodgerBlue; Name: 'claDodgerBlue'),
(Value: TAlphaColors.Firebrick; Name: 'claFirebrick'),
(Value: TAlphaColors.FloralWhite; Name: 'claFloralWhite'),
(Value: TAlphaColors.ForestGreen; Name: 'claForestGreen'),
(Value: TAlphaColors.Fuchsia; Name: 'claFuchsia'),
(Value: TAlphaColors.Gainsboro; Name: 'claGainsboro'),
(Value: TAlphaColors.GhostWhite; Name: 'claGhostWhite'),
(Value: TAlphaColors.GoldenRod; Name: 'claGoldenRod'),
(Value: TAlphaColors.Gold; Name: 'claGold'),
(Value: TAlphaColors.Gray; Name: 'claGray'),
(Value: TAlphaColors.Green; Name: 'claGreen'),
(Value: TAlphaColors.GreenYellow; Name: 'claGreenYellow'),
(Value: TAlphaColors.Grey; Name: 'claGrey'),
(Value: TAlphaColors.HoneyDew; Name: 'claHoneyDew'),
(Value: TAlphaColors.HotPink; Name: 'claHotPink'),
(Value: TAlphaColors.IndianRed; Name: 'claIndianRed'),
(Value: TAlphaColors.Indigo; Name: 'claIndigo'),
(Value: TAlphaColors.Ivory; Name: 'claIvory'),
(Value: TAlphaColors.Khaki; Name: 'claKhaki'),
(Value: TAlphaColors.LavenderBlush; Name: 'claLavenderBlush'),
(Value: TAlphaColors.Lavender; Name: 'claLavender'),
(Value: TAlphaColors.LawnGreen; Name: 'claLawnGreen'),
(Value: TAlphaColors.LegacySkyBlue; Name: 'claLegacySkyBlue'),
(Value: TAlphaColors.LemonChiffon; Name: 'claLemonChiffon'),
(Value: TAlphaColors.LightBlue; Name: 'claLightBlue'),
(Value: TAlphaColors.LightCoral; Name: 'claLightCoral'),
(Value: TAlphaColors.LightCyan; Name: 'claLightCyan'),
(Value: TAlphaColors.LightGoldenRodYellow; Name: 'claLightGoldenRodYellow'),
(Value: TAlphaColors.LightGray; Name: 'claLightGray'),
(Value: TAlphaColors.LightGreen; Name: 'claLightGreen'),
(Value: TAlphaColors.LightGrey; Name: 'claLightGrey'),
(Value: TAlphaColors.LightPink; Name: 'claLightPink'),
(Value: TAlphaColors.LightSalmon; Name: 'claLightSalmon'),
(Value: TAlphaColors.LightSeaGreen; Name: 'claLightSeaGreen'),
(Value: TAlphaColors.LightSkyBlue; Name: 'claLightSkyBlue'),
(Value: TAlphaColors.LightSlateGray; Name: 'claLightSlateGray'),
(Value: TAlphaColors.LightSlateGrey; Name: 'claLightSlateGrey'),
(Value: TAlphaColors.LightSteelBlue; Name: 'claLightSteelBlue'),
(Value: TAlphaColors.LightYellow; Name: 'claLightYellow'),
(Value: TAlphaColors.LimeGreen; Name: 'claLimeGreen'),
(Value: TAlphaColors.Lime; Name: 'claLime'),
(Value: TAlphaColors.Linen; Name: 'claLinen'),
(Value: TAlphaColors.LtGray; Name: 'claLtGray'),
(Value: TAlphaColors.Magenta; Name: 'claMagenta'),
(Value: TAlphaColors.Maroon; Name: 'claMaroon'),
(Value: TAlphaColors.MedGray; Name: 'claMedGray'),
(Value: TAlphaColors.MediumAquaMarine; Name: 'claMediumAquaMarine'),
(Value: TAlphaColors.MediumBlue; Name: 'claMediumBlue'),
(Value: TAlphaColors.MediumOrchid; Name: 'claMediumOrchid'),
(Value: TAlphaColors.MediumPurple; Name: 'claMediumPurple'),
(Value: TAlphaColors.MediumSeaGreen; Name: 'claMediumSeaGreen'),
(Value: TAlphaColors.MediumSlateBlue; Name: 'claMediumSlateBlue'),
(Value: TAlphaColors.MediumSpringGreen; Name: 'claMediumSpringGreen'),
(Value: TAlphaColors.MediumTurquoise; Name: 'claMediumTurquoise'),
(Value: TAlphaColors.MediumVioletRed; Name: 'claMediumVioletRed'),
(Value: TAlphaColors.MidnightBlue; Name: 'claMidnightBlue'),
(Value: TAlphaColors.MintCream; Name: 'claMintCream'),
(Value: TAlphaColors.MistyRose; Name: 'claMistyRose'),
(Value: TAlphaColors.Moccasin; Name: 'claMoccasin'),
(Value: TAlphaColors.MoneyGreen; Name: 'claMoneyGreen'),
(Value: TAlphaColors.NavajoWhite; Name: 'claNavajoWhite'),
(Value: TAlphaColors.Navy; Name: 'claNavy'),
(Value: TAlphaColors.Null; Name: 'claNull'),
(Value: TAlphaColors.OldLace; Name: 'claOldLace'),
(Value: TAlphaColors.OliveDrab; Name: 'claOliveDrab'),
(Value: TAlphaColors.Olive; Name: 'claOlive'),
(Value: TAlphaColors.Orange; Name: 'claOrange'),
(Value: TAlphaColors.OrangeRed; Name: 'claOrangeRed'),
(Value: TAlphaColors.Orchid; Name: 'claOrchid'),
(Value: TAlphaColors.PaleGoldenRod; Name: 'claPaleGoldenRod'),
(Value: TAlphaColors.PaleGreen; Name: 'claPaleGreen'),
(Value: TAlphaColors.PaleTurquoise; Name: 'claPaleTurquoise'),
(Value: TAlphaColors.PaleVioletRed; Name: 'claPaleVioletRed'),
(Value: TAlphaColors.PapayaWhip; Name: 'claPapayaWhip'),
(Value: TAlphaColors.PeachPuff; Name: 'claPeachPuff'),
(Value: TAlphaColors.Peru; Name: 'claPeru'),
(Value: TAlphaColors.Pink; Name: 'claPink'),
(Value: TAlphaColors.Plum; Name: 'claPlum'),
(Value: TAlphaColors.PowderBlue; Name: 'claPowderBlue'),
(Value: TAlphaColors.Purple; Name: 'claPurple'),
(Value: TAlphaColors.Red; Name: 'claRed'),
(Value: TAlphaColors.RosyBrown; Name: 'claRosyBrown'),
(Value: TAlphaColors.RoyalBlue; Name: 'claRoyalBlue'),
(Value: TAlphaColors.SaddleBrown; Name: 'claSaddleBrown'),
(Value: TAlphaColors.Salmon; Name: 'claSalmon'),
(Value: TAlphaColors.SandyBrown; Name: 'claSandyBrown'),
(Value: TAlphaColors.SeaGreen; Name: 'claSeaGreen'),
(Value: TAlphaColors.SeaShell; Name: 'claSeaShell'),
(Value: TAlphaColors.Sienna; Name: 'claSienna'),
(Value: TAlphaColors.Silver; Name: 'claSilver'),
(Value: TAlphaColors.SkyBlue; Name: 'claSkyBlue'),
(Value: TAlphaColors.SlateBlue; Name: 'claSlateBlue'),
(Value: TAlphaColors.SlateGray; Name: 'claSlateGray'),
(Value: TAlphaColors.SlateGrey; Name: 'claSlateGrey'),
(Value: TAlphaColors.Snow; Name: 'claSnow'),
(Value: TAlphaColors.SpringGreen; Name: 'claSpringGreen'),
(Value: TAlphaColors.SteelBlue; Name: 'claSteelBlue'),
(Value: TAlphaColors.Tan; Name: 'claTan'),
(Value: TAlphaColors.Teal; Name: 'claTeal'),
(Value: TAlphaColors.Thistle; Name: 'claThistle'),
(Value: TAlphaColors.Tomato; Name: 'claTomato'),
(Value: TAlphaColors.Turquoise; Name: 'claTurquoise'),
(Value: TAlphaColors.Violet; Name: 'claViolet'),
(Value: TAlphaColors.Wheat; Name: 'claWheat'),
(Value: TAlphaColors.White; Name: 'claWhite'),
(Value: TAlphaColors.WhiteSmoke; Name: 'claWhiteSmoke'),
(Value: TAlphaColors.YellowGreen; Name: 'claYellowGreen'),
(Value: TAlphaColors.Yellow; Name: 'claYellow')
);
implementation
{$IFDEF FPC_DOTTEDUNITS}
uses System.SysUtils;
{$ELSE}
uses SysUtils;
{$ENDIF}
{ ****************************************************************************
Colors
****************************************************************************}
function ColorToIdent(Color: LongInt;var Ident: string): Boolean;
begin
Result:=IntToIdent(Color,Ident,ColorNames);
end;
function IdentToColor(const Ident: string;var Color: LongInt): Boolean;
begin
Result:=IdentToInt(Ident,Color,ColorNames);
end;
function ColorToString(Color: TColor): string;
begin
if ColorToIdent(Color,Result) then
exit;
Result:=Format('$%0.8x',[Integer(Color)]);
end;
function StringToColor(const S: string): TColor;
begin
if IdentToColor(S,LongInt(Result)) then
exit;
Result:=TColor(StrToIntDef(S,Integer(TColorRec.Black)));
end;
procedure GetColorValues(Proc: TGetStrProc);
var
C: Integer;
begin
for C:=Low(ColorNames) to High(ColorNames) do
Proc(ColorNames[C].Name);
end;
procedure RegisterColorIntegerConsts;
begin
if Assigned(FindIntToIdent(TypeInfo(TColor))) then
exit;
RegisterIntegerConsts(TypeInfo(TColor),@IdentToColor,@ColorToIdent);
end;
{ ****************************************************************************
AlphaColors
****************************************************************************}
function AlphaColorToIdent(Color: LongInt; var Ident: string): Boolean;
begin
Result:=IntToIdent(Color,Ident,AlphaColorNames);
if not Result then
begin
Ident:='x'+IntToHex(Color,8);
Result:=True;
end;
end;
function IdentToAlphaColor(const Ident: string; var Color: LongInt): Boolean;
var
S: string;
begin
S:=Ident;
Result:=(Length(S)>1) and (S[1]='x');
if Result then
Color:=Integer(StringToAlphaColor(S))
else
begin
Result:=IdentToInt(S,Color,AlphaColorNames);
if not Result and (Length(S)>2) and (S[1]='c') and (S[2]='l') then
begin
Insert('a',S,3);
Result:=IdentToInt(S,Color,AlphaColorNames);
end;
end;
end;
procedure GetAlphaColorValues(Proc: TGetStrProc);
var
AC: Integer;
begin
for AC:=Low(AlphaColorNames) to High(AlphaColorNames) do
Proc(Copy(AlphaColorNames[AC].Name,4));
end;
function AlphaColorToString(Value: TAlphaColor): string;
begin
Result:='';
if AlphaColorToIdent(Integer(Value),Result) then
begin
if Result[1]='x' then
Result[1]:='#'
else
Delete(Result,1,3); // Strip cla...
end;
end;
function StringToAlphaColor(const Value: string): TAlphaColor;
var
S: string;
begin
S:=Value;
if (S=#0) or (S='') then
Result:=TAlphaColors.Black
else if (Length(S)>0) and (S[1] in ['#','x']) then
begin
S:='$'+Copy(S,2);
Result:=TAlphaColor(StrToIntDef(S,TAlphaColors.Black));
end
else
if not IdentToAlphaColor(S,LongInt(Result)) then
if not IdentToAlphaColor('cla'+S,LongInt(Result)) then
Result:=TAlphaColor(StrToIntDef(S,TAlphaColors.Black));
end;
procedure RegisterAlphaColorIntegerConsts;
begin
if not Assigned(FindIntToIdent(TypeInfo(TAlphaColor))) then
RegisterIntegerConsts(TypeInfo(TAlphaColor),@IdentToAlphaColor,@AlphaColorToIdent);
end;
function AlphaColorToColor(const Color: TAlphaColor): TColor;
Var
R : TColorRec;
begin
R.A:=0;
R.R:=TAlphaColorRec(Color).R;
R.G:=TAlphaColorRec(Color).G;
R.B:=TAlphaColorRec(Color).B;
Result:=TColor(R);
end;
function AppendColor(Start, Stop: TAlphaColor): TAlphaColor;
function Channel(aStart,aStop : Byte) : byte;
var
R : Integer;
begin
Result:=MaxColorChannel;
R:=aStart+aStop;
if R=0 then
Result:=R;
end;
var
RSA : TAlphaColorRec absolute start;
RSS : TAlphaColorRec absolute stop;
R : TAlphaColorRec absolute Result;
begin
R.A:=Channel(RSA.A,RSS.A);
R.R:=Channel(RSA.R,RSS.R);
R.G:=Channel(RSA.G,RSS.G);
R.B:=Channel(RSA.B,RSS.B);
end;
function RGBtoBGR(const C: TAlphaColor): TAlphaColor;
Var
R : TAlphaColorRec absolute result;
CR : TAlphaColorRec absolute c;
begin
Result:=C;
R.R:=CR.B;
R.B:=CR.R;
end;
function CorrectColor(const C: TAlphaColor): TAlphaColor;
begin
{$IFNDEF WINDOWS}
Result:=RGBtoBGR(C);
{$ELSE}
Result:=C;
{$ENDIF}
end;
function PremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
Function Mul(C,A : Byte) : Byte; inline;
begin
Result:=Trunc(C*A/MaxColorChannel);
end;
var
CR : TAlphaColorRec absolute C;
R : TAlphaColorRec absolute Result;
begin
if CR.A=0 then
Result:=0
else if CR.A=MaxColorChannel then
Result:=C
else
begin
R.A:=CR.A;
R.R:=Mul(CR.R,CR.A);
R.G:=Mul(CR.G,CR.A);
R.B:=Mul(CR.B,CR.A);
end;
end;
function UnpremultiplyAlpha(const C: TAlphaColor): TAlphaColor;
Function CDiv(C,A : Byte) : Byte; inline;
begin
Result:=Trunc(C/A/MaxColorChannel);
end;
var
CR : TAlphaColorRec absolute C;
R : TAlphaColorRec absolute Result;
begin
if CR.A=0 then
Result:=0
else if CR.A=MaxColorChannel then
Result:=C
else
begin
R.A:=CR.A;
R.R:=CDiv(CR.R,CR.A);
R.G:=CDiv(CR.G,CR.A);
R.B:=CDiv(CR.B,CR.A);
end;
end;
function MakeColor(const C: TAlphaColor; const AOpacity: Single): TAlphaColor;
var
CR : TAlphaColorRec absolute C;
R : TAlphaColorRec absolute Result;
begin
Result:=C;
if AOpacity<1 then
R.A:=trunc(CR.A*AOpacity);
end;
function MakeColor(R, G, B: Byte; A: Byte = MaxColorChannel): TAlphaColor;
var
RC : TAlphaColorRec absolute Result;
begin
RC.A:=A;
RC.R:=R;
RC.G:=G;
RC.B:=B;
end;
function LimitRange01(v : single):single;inline;
begin
if V<0 then
V:=0
else if V>1 then
V:=1;
Result:=V;
end;
// Only valid for -1<=V<=2
function ToRange01(v : single):single;inline;
begin
if V<0 then
V:=V+1
else if V>1 then
V:=V-1;
Result:=V;
end;
function Max(A,B: Single):Single;inline;
begin
if (A>B) then Result:=A else Result:=B;
end;
function Min(A,B: Single):Single;inline;
begin
if (A