paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-06 14:20:59 +01:00
Code Issues Packages Projects Releases Wiki Activity

CairoCanvas: implements MixedRoundRect

Browse Source 
git-svn-id: trunk@40980 -
This commit is contained in:
jesus 2013-05-01 23:20:12 +00:00
parent 8427f571d8
commit 24fb6810b9
1 changed files with 55 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
components/cairocanvas/cairocanvas.pas
View File

@ -2,6 +2,10 @@ unit CairoCanvas;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$if (FPC_FULLVERSION>=20701)}
{$Packset 1}
{$endif}
{$define pangocairo} {$define pangocairo}
{-$define breaklines} // disabled as it's not UTF-8 safe {-$define breaklines} // disabled as it's not UTF-8 safe
@ -16,6 +20,8 @@ uses
; ;
type type
TSquaredCorners = set of (scTopLeft,scBottomLeft,scBottomRight,scTopRight);
{ TCairoPrinterCanvas } { TCairoPrinterCanvas }
TCairoPrinterCanvas = class(TFilePrinterCanvas) TCairoPrinterCanvas = class(TFilePrinterCanvas)
@ -95,6 +101,8 @@ type
function GetTextMetrics(out M: TLCLTextMetric): boolean; override; function GetTextMetrics(out M: TLCLTextMetric): boolean; override;
procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override; procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override;
procedure SetPixel(X,Y: Integer; Value: TColor); override; procedure SetPixel(X,Y: Integer; Value: TColor); override;
public
procedure MixedRoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer; SquaredCorners: TSquaredCorners);
{ Not implemented { Not implemented
procedure FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle); override; procedure FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle); override;
procedure CopyRect(const Dest: TRect; SrcCanvas: TCanvas; const Source: TRect); override; procedure CopyRect(const Dest: TRect; SrcCanvas: TCanvas; const Source: TRect); override;
@ -596,6 +604,53 @@ begin
Changed; Changed;
end; end;
procedure TCairoPrinterCanvas.MixedRoundRect(X1, Y1, X2, Y2: Integer; RX,
RY: Integer; SquaredCorners: TSquaredCorners);
begin
Changing;
RequiredState([csHandleValid, csPenValid, csBrushValid]);
cairo_move_to(cr, SX(X1+RX), SY(Y1));
cairo_line_to(cr, SX(X2-RX), SY(Y1));
if scTopRight in SquaredCorners then
begin
cairo_line_to(cr, SX(X2), SY(Y1));
cairo_line_to(cr, SX(X2), SY(Y1+RY));
end else
EllipseArcPath(X2-RX, Y1+RY, RX, RY, -PI/2, 0, True, True);
cairo_line_to(cr, SX(X2), SY(Y2-RY));
if scBottomRight in SquaredCorners then
begin
cairo_line_to(cr, SX(X2), SY(Y2));
cairo_line_to(cr, SX(X2-RX), SY(Y2));
end else
EllipseArcPath(X2-RX, Y2-RY, RX, RY, 0, PI/2, True, True);
cairo_line_to(cr, SX(X1+RX), SY(Y2));
if scBottomLeft in SquaredCorners then
begin
cairo_line_to(cr, SX(X1), SY(Y2));
cairo_line_to(cr, SX(X1), SY(Y2-RY));
end else
EllipseArcPath(X1+RX, Y2-RY, RX, RY, PI/2, PI, True, True);
cairo_line_to(cr, SX(X1), SY(Y1+RX));
if scTopLeft in SquaredCorners then
begin
cairo_line_to(cr, SX(X1), SY(Y1));
cairo_line_to(cr, SX(X1+RX), SY(Y1));
end else
EllipseArcPath(X1+RX, Y1+RY, RX, RY, PI, PI*1.5, True, True);
FillAndStroke;
Changed;
end;
procedure TCairoPrinterCanvas.Ellipse(X1, Y1, X2, Y2: Integer); procedure TCairoPrinterCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
begin begin
Changing; Changing;