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