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

CairoCanvas: Implemented DrawSurface to draw a cairo surface onto canvas

Browse Source 
git-svn-id: trunk@40984 -
This commit is contained in:
jesus 2013-05-02 00:16:38 +00:00
parent 807058aba7
commit 3d48b60eec
1 changed files with 20 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
components/cairocanvas/cairocanvas.pas
View File

@ -107,6 +107,7 @@ type
procedure SetPixel(X,Y: Integer; Value: TColor); override;
public
procedure MixedRoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer; SquaredCorners: TSquaredCorners);
procedure DrawSurface(const SourceRect, DestRect: TRect; surface: Pcairo_surface_t);
{ Not implemented
procedure FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle); override;
procedure CopyRect(const Dest: TRect; SrcCanvas: TCanvas; const Source: TRect); override;
@ -705,6 +706,25 @@ begin
Changed;
end;
procedure TCairoPrinterCanvas.DrawSurface(const SourceRect, DestRect: TRect;
surface: Pcairo_surface_t);
var
SW, SH: Double;
begin
Changing;
RequiredState([csHandleValid]);
cairo_save(cr);
cairo_translate(cr, SX(DestRect.Left), SY(DestRect.Top));
SW := (DestRect.Right - DestRect.Left)/(SourceRect.Right-SourceRect.Left);
SH := (DestRect.Bottom - DestRect.Top)/(SourceRect.Bottom-SourceRect.Top);
cairo_scale(cr, SX2(SW), SY2(SH));
cairo_set_source_surface(cr, surface, 0, 0);
cairo_paint(cr);
cairo_restore(cr);
Changed;
end;
procedure TCairoPrinterCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
begin
Changing;