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

lcl: add delphi compatibility stuff to GraphUtil

Browse Source 
git-svn-id: trunk@14955 -
This commit is contained in:
paul 2008-04-25 00:54:04 +00:00
parent aecb127993
commit 77fc8fc4c2
1 changed files with 43 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
lcl/graphutil.pp
View File

@ -27,7 +27,7 @@ unit GraphUtil;
interface
uses
Graphics, Math;
Graphics, Math, LCLType;
function ColorToGray(const AColor: TColor): Byte;
procedure ColorToHLS(const AColor: TColor; var H, L, S: Byte);
@ -35,6 +35,13 @@ procedure RGBtoHLS(const R, G, B: Byte; var H, L, S: Byte);
function HLStoColor(const H, L, S: Byte): TColor;
procedure HLStoRGB(const H, L, S: Byte; var R, G, B: Byte);
// delphi compatibility
procedure ColorRGBToHLS(clrRGB: COLORREF; var Hue, Luminance, Saturation: Word);
function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef;
function ColorAdjustLuma(clrRGB: TColor; n: Integer; fScale: BOOL): TColor;
function GetHighLightColor(const Color: TColor; Luminance: Integer = 19): TColor;
function GetShadowColor(const Color: TColor; Luminance: Integer = -50): TColor;
implementation
//TODO: Check code on endianess
@ -168,5 +175,39 @@ begin
end;
end;
procedure ColorRGBToHLS(clrRGB: COLORREF; var Hue, Luminance, Saturation: Word);
var
H, L, S: Byte;
begin
ColorToHLS(clrRGB, H, L, S);
Hue := H;
Luminance := L;
Saturation := S;
end;
end.
function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef;
begin
Result := HLStoColor(Hue, Luminance, Saturation);
end;
function ColorAdjustLuma(clrRGB: TColor; n: Integer; fScale: BOOL): TColor;
var
H, L, S: Byte;
begin
// what is fScale?
ColorToHLS(clrRGB, H, L, S);
Result := HLStoColor(H, L + n, S);
end;
function GetHighLightColor(const Color: TColor; Luminance: Integer): TColor;
begin
Result := ColorAdjustLuma(Color, Luminance, False);
end;
function GetShadowColor(const Color: TColor; Luminance: Integer): TColor;
begin
Result := ColorAdjustLuma(Color, Luminance, False);
end;
end.