paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-07 07:16:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

aggpas: started GradientFill

Browse Source 
git-svn-id: trunk@22120 -
This commit is contained in:
mattias 2009-10-12 16:42:38 +00:00
parent a4e6d005ef
commit 8d86a00845
2 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/aggpas/lazarus/example/unit2.pas
View File

@ -53,6 +53,9 @@ begin
Line(12,12,22,22); Line(12,12,22,22);
FillRect(40,10,50,20); FillRect(40,10,50,20);
Ellipse(55,10,65,20);
GradientFill(Rect(70,10,80,20),clRed,clBlue,gdVertical);
end; end;
// convert to LCL native pixel format // convert to LCL native pixel format
@ -69,6 +72,7 @@ begin
Line(24,24,34,34); Line(24,24,34,34);
FillRect(40,22,50,32); FillRect(40,22,50,32);
Ellipse(55,22,65,32);
end; end;
end; end;

28
components/aggpas/src/agg_lcl.pas
View File

@ -101,12 +101,20 @@ type
procedure Changing; virtual; procedure Changing; virtual;
procedure Changed; virtual; procedure Changed; virtual;
// extra drawing methods (there are more in the ancestor TFPCustomCanvas)
//procedure Arc(ALeft, ATop, ARight, ABottom, angle1, angle2: Integer); virtual;
//procedure Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual;
procedure FillRect(const ARect: TRect); virtual; procedure FillRect(const ARect: TRect); virtual;
procedure FillRect(X1,Y1,X2,Y2: Integer); procedure FillRect(X1,Y1,X2,Y2: Integer);
procedure GradientFill(ARect: TRect; AStart, AStop: TColor; ADirection: TGradientDirection);
end; end;
procedure InitAggPasRawImageDescriptor(APixelFormat: TAggFPImgPixelFormat; procedure InitAggPasRawImageDescriptor(APixelFormat: TAggFPImgPixelFormat;
AWidth, AHeight: cardinal; out Desc: TRawImageDescription); AWidth, AHeight: cardinal; out Desc: TRawImageDescription);
function AggToLCLColor(const c: TAggColor): TColor;
function LCLToAggColor(const c: TColor): TAggColor;
implementation implementation
@ -140,6 +148,17 @@ begin
end; end;
end; end;
function AggToLCLColor(const c: TAggColor): TColor;
begin
Result:=RGBToColor(c.r,c.g,c.b);
end;
function LCLToAggColor(const c: TColor): TAggColor;
begin
Result.a:=0;
RedGreenBlue(ColorToRGB(c),Result.r,Result.g,Result.b);
end;
{ TAggLCLCanvas } { TAggLCLCanvas }
function TAggLCLCanvas.DoCreateDefaultBrush: TFPCustomBrush; function TAggLCLCanvas.DoCreateDefaultBrush: TFPCustomBrush;
@ -249,6 +268,15 @@ begin
AggDrawPath(AGG_FillOnly); AggDrawPath(AGG_FillOnly);
end; end;
procedure TAggLCLCanvas.GradientFill(ARect: TRect; AStart, AStop: TColor;
ADirection: TGradientDirection);
begin
raise Exception.Create('TAggLCLCanvas.GradientFill ToDo');
AggFillLinearGradient(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom,
LCLToAggColor(AStart),LCLToAggColor(AStop));
FillRect(ARect);
end;
{ TAggLCLBrush } { TAggLCLBrush }
procedure TAggLCLBrush.SetColor(const AValue: TColor); procedure TAggLCLBrush.SetColor(const AValue: TColor);