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   laz2_dom,
35   // LCL
36   lazutf8, lazregions,
37   Graphics, LCLIntf, LCLType, intfgraphics, graphtype, interfacebase,
38   // AggPas
39   agg_fpimage, Agg_LCL,
40   // fpvectorial
41   fpvutils, fpvectorial;
42 
43 type
44 
45   { TFPVAggPasRenderer }
46 
47   TFPVAggPasRenderer = class(TvRenderer)
48   private
49     Bitmap: TBitmap;
50     AggLCLCanvas: TAggLCLCanvas;
51   public
52     procedure BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); override;
53     procedure EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); override;
54     // TPath
55     procedure TPath_Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean; APath: TPath); override;
56   end;
57 
58 implementation
59 
60 
61 { TFPVAggPasRenderer }
62 
63 procedure TFPVAggPasRenderer.BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
64 var
65   HasFont: Boolean;
66   FontFilename: String;
67 begin
68   Bitmap := TBitmap.Create;
69   AggLCLCanvas:=TAggLCLCanvas.Create;
70   AggLCLCanvas.Image.PixelFormat:=afpimRGBA32;
71   AggLCLCanvas.Image.SetSize(2000, 2000);
72 
73   {$IFDEF LCLGtk2}
74   {HasFont:=true;
75   FontFilename:=SetDirSeparators('../../verdana.ttf');
76   if not FileExistsUTF8(FontFilename) then begin
77     ShowMessage('file not found: '+FontFilename+' CurDir='+GetCurrentDirUTF8);
78     HasFont:=false;
79   end; }
80   // paint to agg canvas
81   {with AggLCLCanvas do begin
82     if HasFont then begin
83       Font.LoadFromFile(FontFilename);
84       Font.Size:=10;
85       Font.Color:=clBlack;
86     end;}
87   {$ELSE}
88   //HasFont:=false;
89   {$ENDIF}
90 
91   // solid white background
92   AggLCLCanvas.Brush.Color:=clWhite;
93   AggLCLCanvas.FillRect(0, 0, AggLCLCanvas.Width, AggLCLCanvas.Height);
94 end;
95 
96 procedure TFPVAggPasRenderer.EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
97 begin
98   // convert to LCL native pixel format
99   Bitmap.LoadFromIntfImage(AggLCLCanvas.Image.IntfImg);
100   TCanvas(ARenderInfo.Canvas).Draw(0, 0, Bitmap);
101 
102   AggLCLCanvas.Free;
103   Bitmap.Free;
104 end;
105 
106 procedure TFPVAggPasRenderer.TPath_Render(var ARenderInfo: TvRenderInfo;
107   ADoDraw: Boolean; APath: TPath);
108 var
109   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
110   ADestX: Integer absolute ARenderInfo.DestX;
111   ADestY: Integer absolute ARenderInfo.DestY;
112   AMulX: Double absolute ARenderInfo.MulX;
113   AMulY: Double absolute ARenderInfo.MulY;
114   //
115   i, j, curPt: Integer;
116   coordX, coordY: Integer;
117   curSegment: TPathSegment;
118   cur2DSegment: T2DSegment absolute curSegment;
119   pts: TPointsArray;
120 begin
121   if not ADoDraw then Exit;
122 
123   AggLCLCanvas.Pen.Style := APath.Pen.Style;
124   AggLCLCanvas.Pen.Width := APath.Pen.Width;
125   AggLCLCanvas.Pen.FPColor := APath.Pen.Color;
126   AggLCLCanvas.Brush.Style := APath.Brush.Style;
127   AggLCLCanvas.Brush.FPColor := APath.Brush.Color;
128   AggLCLCanvas.Brush.AggFillEvenOdd := APath.ClipMode = vcmEvenOddRule;
129 
130   AggLCLCanvas.AggResetPath;
131   APath.PrepareForSequentialReading;
132   for j := 0 to APath.Len - 1 do
133   begin
134     curSegment := TPathSegment(APath.Next);
135     case curSegment.SegmentType of
136       stMoveTo:
137         begin
138           inc(i);
139           coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
140           coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
141           AggLCLCanvas.AggMoveTo(coordX, coordY);
142         end;
143       st2DLineWithPen, st2DLine, st3DLine:
144         begin
145           coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
146           coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
147           if curSegment.SegmentType = st2DLineWithPen then
148           begin
149             AggLCLCanvas.Pen.FPColor := APath.AdjustColorToBackground(T2DSegmentWithPen(Cur2DSegment).Pen.Color, ARenderInfo);
150             AggLCLCanvas.Pen.Width := T2DSegmentWithPen(cur2DSegment).Pen.Width;
151             AggLCLCanvas.Pen.Style := T2DSegmentWithPen(cur2DSegment).Pen.Style;
152             AggLCLCanvas.AggLineTo(coordX, coordY);
153             AggLCLCanvas.Pen.Style := APath.Pen.Style;
154             AggLCLCanvas.Pen.Width := APath.Pen.Width;
155             AggLCLCanvas.Pen.FPColor := APath.Pen.Color;
156           end
157           else
158             AggLCLCanvas.AggLineTo(coordX, coordY);
159         end;
160       st2DBezier, st3DBezier, st2DEllipticalArc:
161         begin
162           coordX := CoordToCanvasX(T2DSegment(curSegment.Previous).X, ADestX, AMulX);
163           coordY := CoordToCanvasY(T2DSegment(curSegment.Previous).Y, ADestY, AMulY);
164 
165           SetLength(pts, 1);
166           pts[0] := Point(coordX, coordY);
167           curSegment.AddToPoints(ADestX, ADestY, AMulX, AMulY, pts);
168           for curPt := 0 to Length(pts)-1 do
169           begin
170             AggLCLCanvas.AggLineTo(pts[curPt].X, pts[curPt].Y);
171           end;
172           AggLCLCanvas.AggMoveTo(pts[High(pts)].X, pts[High(pts)].Y);
173         end;
174     end;
175   end;
176   if APath.Len > 0 then
177   begin
178     AggLCLCanvas.AggClosePolygon;
179     AggLCLCanvas.AggDrawPath(AGG_FillAndStroke, False);
180   end;
181 end;
182 
183 end.
184 
185