1 {
2 Implements support for drawing to the LCL TCanvas via AggPas
3 
4 License: The same modified LGPL as the Free Pascal RTL
5          See the file COPYING.modifiedLGPL for more details
6 
7 AUTHORS: Felipe Monteiro de Carvalho
8 }
9 unit fpvectorial2aggpas;
10 
11 {$ifdef fpc}
12   {$mode objfpc}{$h+}
13 {$endif}
14 
15 {$define USE_CANVAS_CLIP_REGION}
16 {.$define DEBUG_CANVAS_CLIP_REGION}
17 
18 {.$define FPVECTORIAL_DEBUG_DIMENSIONS}
19 {.$define FPVECTORIAL_TOCANVAS_DEBUG}
20 {.$define FPVECTORIAL_DEBUG_BLOCKS}
21 {.$define FPVECTORIAL_AUTOFIT_DEBUG}
22 {.$define FPVECTORIAL_SUPPORT_LAZARUS_1_6}
23 // visual debugs
24 {.$define FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
25 {.$define FPVECTORIAL_RENDERINFO_VISUALDEBUG}
26 
27 interface
28 
29 uses
30   Classes, SysUtils, Math, TypInfo, contnrs, Types,
31   // FCL-Image
32   FPCanvas, FPImage, FPWriteBMP,
33   // lazutils
34   GraphType, LazUTF8, laz2_dom,
35   // LCL
36   LazRegions, Graphics, LCLIntf, LCLType, IntfGraphics, InterfaceBase,
37   // AggPas
38   agg_fpimage, Agg_LCL,
39   // fpvectorial
40   fpvutils, fpvectorial;
41 
42 type
43 
44   { TFPVAggPasRenderer }
45 
46   TFPVAggPasRenderer = class(TvRenderer)
47   private
48     Bitmap: TBitmap;
49     AggLCLCanvas: TAggLCLCanvas;
50   public
51     procedure BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); override;
52     procedure EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); override;
53     // TPath
54     procedure TPath_Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean; APath: TPath); override;
55   end;
56 
57 implementation
58 
59 
60 { TFPVAggPasRenderer }
61 
62 procedure TFPVAggPasRenderer.BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
63 var
64   HasFont: Boolean;
65   FontFilename: String;
66 begin
67   Bitmap := TBitmap.Create;
68   AggLCLCanvas:=TAggLCLCanvas.Create;
69   AggLCLCanvas.Image.PixelFormat:=afpimRGBA32;
70   AggLCLCanvas.Image.SetSize(2000, 2000);
71 
72   {$IFDEF LCLGtk2}
73   {HasFont:=true;
74   FontFilename:=SetDirSeparators('../../verdana.ttf');
75   if not FileExistsUTF8(FontFilename) then begin
76     ShowMessage('file not found: '+FontFilename+' CurDir='+GetCurrentDirUTF8);
77     HasFont:=false;
78   end; }
79   // paint to agg canvas
80   {with AggLCLCanvas do begin
81     if HasFont then begin
82       Font.LoadFromFile(FontFilename);
83       Font.Size:=10;
84       Font.Color:=clBlack;
85     end;}
86   {$ELSE}
87   //HasFont:=false;
88   {$ENDIF}
89 
90   // solid white background
91   AggLCLCanvas.Brush.Color:=clWhite;
92   AggLCLCanvas.FillRect(0, 0, AggLCLCanvas.Width, AggLCLCanvas.Height);
93 end;
94 
95 procedure TFPVAggPasRenderer.EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
96 begin
97   // convert to LCL native pixel format
98   Bitmap.LoadFromIntfImage(AggLCLCanvas.Image.IntfImg);
99   TCanvas(ARenderInfo.Canvas).Draw(0, 0, Bitmap);
100 
101   AggLCLCanvas.Free;
102   Bitmap.Free;
103 end;
104 
105 procedure TFPVAggPasRenderer.TPath_Render(var ARenderInfo: TvRenderInfo;
106   ADoDraw: Boolean; APath: TPath);
107 var
108   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
109   ADestX: Integer absolute ARenderInfo.DestX;
110   ADestY: Integer absolute ARenderInfo.DestY;
111   AMulX: Double absolute ARenderInfo.MulX;
112   AMulY: Double absolute ARenderInfo.MulY;
113   //
114   i, j, curPt: Integer;
115   coordX, coordY: Integer;
116   curSegment: TPathSegment;
117   cur2DSegment: T2DSegment absolute curSegment;
118   pts: TPointsArray;
119 begin
120   if not ADoDraw then Exit;
121 
122   AggLCLCanvas.Pen.Style := APath.Pen.Style;
123   AggLCLCanvas.Pen.Width := APath.Pen.Width;
124   AggLCLCanvas.Pen.FPColor := APath.Pen.Color;
125   AggLCLCanvas.Brush.Style := APath.Brush.Style;
126   AggLCLCanvas.Brush.FPColor := APath.Brush.Color;
127   AggLCLCanvas.Brush.AggFillEvenOdd := APath.ClipMode = vcmEvenOddRule;
128 
129   AggLCLCanvas.AggResetPath;
130   APath.PrepareForSequentialReading;
131   for j := 0 to APath.Len - 1 do
132   begin
133     curSegment := TPathSegment(APath.Next);
134     case curSegment.SegmentType of
135       stMoveTo:
136         begin
137           inc(i);
138           coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
139           coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
140           AggLCLCanvas.AggMoveTo(coordX, coordY);
141         end;
142       st2DLineWithPen, st2DLine, st3DLine:
143         begin
144           coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
145           coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
146           if curSegment.SegmentType = st2DLineWithPen then
147           begin
148             AggLCLCanvas.Pen.FPColor := APath.AdjustColorToBackground(T2DSegmentWithPen(Cur2DSegment).Pen.Color, ARenderInfo);
149             AggLCLCanvas.Pen.Width := T2DSegmentWithPen(cur2DSegment).Pen.Width;
150             AggLCLCanvas.Pen.Style := T2DSegmentWithPen(cur2DSegment).Pen.Style;
151             AggLCLCanvas.AggLineTo(coordX, coordY);
152             AggLCLCanvas.Pen.Style := APath.Pen.Style;
153             AggLCLCanvas.Pen.Width := APath.Pen.Width;
154             AggLCLCanvas.Pen.FPColor := APath.Pen.Color;
155           end
156           else
157             AggLCLCanvas.AggLineTo(coordX, coordY);
158         end;
159       st2DBezier, st3DBezier, st2DEllipticalArc:
160         begin
161           coordX := CoordToCanvasX(T2DSegment(curSegment.Previous).X, ADestX, AMulX);
162           coordY := CoordToCanvasY(T2DSegment(curSegment.Previous).Y, ADestY, AMulY);
163 
164           SetLength(pts, 1);
165           pts[0] := Point(coordX, coordY);
166           curSegment.AddToPoints(ADestX, ADestY, AMulX, AMulY, pts);
167           for curPt := 0 to Length(pts)-1 do
168           begin
169             AggLCLCanvas.AggLineTo(pts[curPt].X, pts[curPt].Y);
170           end;
171           AggLCLCanvas.AggMoveTo(pts[High(pts)].X, pts[High(pts)].Y);
172         end;
173     end;
174   end;
175   if APath.Len > 0 then
176   begin
177     AggLCLCanvas.AggClosePolygon;
178     AggLCLCanvas.AggDrawPath(AGG_FillAndStroke, False);
179   end;
180 end;
181 
182 end.
183 
184