paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-24 00:28:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, Graphics.pp: added IncColor() counterpart to the existing DecColor() function, patch by Don Siders, issue #40682

Browse Source
This commit is contained in:
Maxim Ganetsky 2024-01-05 18:55:58 +03:00
parent 4da22ba599
commit c9a4f79b92
1 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lcl/graphics.pp
View File

@ -1925,6 +1925,7 @@ function StringToColorDef(const S: shortstring; const DefaultValue: TColor): TCo
procedure GetColorValues(Proc: TGetColorStringProc);
function InvertColor(AColor: TColor): TColor;
function DecColor(AColor: TColor; AQuantity: Byte): TColor;
function IncColor(AColor: TColor; AQuantity: Byte): TColor;
function IsSysColor(AColor: TColorRef): Boolean;
function Blue(rgb: TColorRef): BYTE; // does not work on system color
@ -2711,6 +2712,18 @@ begin
Result := RGBToColor(R, G, B);
end;
// Increases the component RGB values in a color by the specified amount
function IncColor(AColor: TColor; AQuantity: Byte): TColor;
var
R, G, B : Byte;
begin
RedGreenBlue(ColorToRGB(AColor), R, G, B);
R := Min(255, Integer(R) + AQuantity);
G := Min(255, Integer(G) + AQuantity);
B := Min(255, Integer(B) + AQuantity);
Result := RGBToColor(R, G, B);
end;
function IsSysColor(AColor: TColorRef): Boolean;
begin
Result := (AColor and SYS_COLOR_BASE) <> 0;