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

lcl: add some useful stuff into graphutil.pp

Browse Source 
git-svn-id: trunk@14956 -
This commit is contained in:
paul 2008-04-25 02:27:17 +00:00
parent 77fc8fc4c2
commit 0b46b68588
1 changed files with 73 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
lcl/graphutil.pp
View File

@ -27,7 +27,7 @@ unit GraphUtil;
interface interface
uses uses
Graphics, Math, LCLType; Types, Graphics, Math, LCLType;
function ColorToGray(const AColor: TColor): Byte; function ColorToGray(const AColor: TColor): Byte;
procedure ColorToHLS(const AColor: TColor; var H, L, S: Byte); procedure ColorToHLS(const AColor: TColor; var H, L, S: Byte);
@ -35,6 +35,19 @@ procedure RGBtoHLS(const R, G, B: Byte; var H, L, S: Byte);
function HLStoColor(const H, L, S: Byte): TColor; function HLStoColor(const H, L, S: Byte): TColor;
procedure HLStoRGB(const H, L, S: Byte; var R, G, B: Byte); procedure HLStoRGB(const H, L, S: Byte; var R, G, B: Byte);
// specific things:
{
Draw gradient from top to bottom with parabolic color grow
}
procedure DrawVerticalGradient(Canvas: TCanvas; ARect: TRect; TopColor, BottomColor: TColor);
{
Draw nice looking window with Title
}
procedure DrawGradientWindow(Canvas: TCanvas; WindowRect: TRect; TitleHeight: Integer; BaseColor: TColor);
// delphi compatibility // delphi compatibility
procedure ColorRGBToHLS(clrRGB: COLORREF; var Hue, Luminance, Saturation: Word); procedure ColorRGBToHLS(clrRGB: COLORREF; var Hue, Luminance, Saturation: Word);
function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef; function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef;
@ -46,6 +59,13 @@ implementation
//TODO: Check code on endianess //TODO: Check code on endianess
procedure ExtractRGB(RGB: Cardinal; var R, G, B: Byte); inline;
begin
R := RGB and $FF;
G := (RGB shr 8) and $FF;
B := (RGB shr 16) and $FF;
end;
function ColorToGray(const AColor: TColor): Byte; function ColorToGray(const AColor: TColor): Byte;
var var
RGB: LongInt; RGB: LongInt;
@ -62,9 +82,7 @@ var
RGB: Cardinal; RGB: Cardinal;
begin begin
RGB := ColorToRGB(AColor); RGB := ColorToRGB(AColor);
R := RGB and $FF; ExtractRGB(RGB, R, G, B);
G := (RGB shr 8) and $FF;
B := (RGB shr 16) and $FF;
RGBtoHLS(R, G, B, H, L, S); RGBtoHLS(R, G, B, H, L, S);
end; end;
@ -209,5 +227,56 @@ begin
Result := ColorAdjustLuma(Color, Luminance, False); Result := ColorAdjustLuma(Color, Luminance, False);
end; end;
procedure DrawVerticalGradient(Canvas: TCanvas; ARect: TRect; TopColor, BottomColor: TColor);
var
y, h: Integer;
r1, g1, b1: byte;
r2, g2, b2: byte;
dr, dg, db: integer;
function GetColor(pos, total: integer): TColor;
function GetComponent(c1, dc: integer): integer;
begin
Result := Round(dc / sqr(total) * sqr(pos) + c1);
end;
begin
Result :=
GetComponent(r1, dr) or
(GetComponent(g1, dg) shl 8) or
(GetComponent(b1, db) shl 16);
end;
procedure CalcDeltas;
begin
ExtractRGB(TopColor, r1, g1, b1);
ExtractRGB(BottomColor, r2, g2, b2);
dr := r2 - r1;
dg := g2 - g1;
db := b2 - b1;
end;
begin
TopColor := ColorToRGB(TopColor);
BottomColor := ColorToRGB(BottomColor);
CalcDeltas;
h := ARect.Bottom - ARect.Top;
for y := ARect.Top to ARect.Bottom do
begin
Canvas.Pen.Color := GetColor(y - ARect.Top, h);
Canvas.Line(ARect.Left, y, ARect.Right, y);
end;
end;
procedure DrawGradientWindow(Canvas: TCanvas; WindowRect: TRect; TitleHeight: Integer; BaseColor: TColor);
begin
Canvas.Brush.Color := BaseColor;
Canvas.FrameRect(WindowRect);
InflateRect(WindowRect, -1, -1);
WindowRect.Bottom := WindowRect.Top + TitleHeight;
DrawVerticalGradient(Canvas, WindowRect, GetHighLightColor(BaseColor), GetShadowColor(BaseColor));
end;
end. end.