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

lcl: add NormalizeRect function

Browse Source 
git-svn-id: trunk@18863 -
This commit is contained in:
paul 2009-03-02 03:09:42 +00:00
parent d45af9b5b8
commit 084ca7e3cd
1 changed files with 28 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
lcl/graphutil.pp
View File

@ -68,6 +68,9 @@ 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;
// misc
function NormalizeRect(const R: TRect): TRect;
implementation
//TODO: Check code on endianess
@ -401,6 +404,31 @@ begin
Result := ColorAdjustLuma(Color, Luminance, False);
end;
function NormalizeRect(const R: TRect): TRect;
begin
if R.Left <= R.Right then
begin
Result.Left := R.Left;
Result.Right := R.Right;
end
else
begin
Result.Left := R.Right;
Result.Right := R.Left;
end;
if R.Top <= R.Bottom then
begin
Result.Top := R.Top;
Result.Bottom := R.Bottom;
end
else
begin
Result.Top := R.Bottom;
Result.Bottom := R.Top;
end;
end;
procedure DrawVerticalGradient(Canvas: TCanvas; ARect: TRect; TopColor, BottomColor: TColor);
var
y, h: Integer;