fpvtocanvas.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591
  1. unit fpvtocanvas;
  2. {$mode objfpc}{$H+}
  3. interface
  4. {.$define USE_LCL_CANVAS}
  5. {$ifdef USE_LCL_CANVAS}
  6. {$define USE_CANVAS_CLIP_REGION}
  7. {.$define DEBUG_CANVAS_CLIP_REGION}
  8. {$endif}
  9. {$ifndef Windows}
  10. {.$define FPVECTORIAL_TOCANVAS_DEBUG}
  11. {$endif}
  12. uses
  13. Classes, SysUtils, Math,
  14. {$ifdef USE_LCL_CANVAS}
  15. Graphics, LCLIntf, LCLType,
  16. {$endif}
  17. fpcanvas,
  18. fpimage,
  19. fpvectorial, fpvutils;
  20. procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage;
  21. ADest: TFPCustomCanvas;
  22. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  23. procedure DrawFPVPathToCanvas(ASource: TvVectorialPage; CurPath: TPath;
  24. ADest: TFPCustomCanvas;
  25. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  26. procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity;
  27. ADest: TFPCustomCanvas;
  28. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  29. procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText;
  30. ADest: TFPCustomCanvas;
  31. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  32. implementation
  33. function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint;
  34. var
  35. sinus, cosinus : Extended;
  36. begin
  37. SinCos(alpha, sinus, cosinus);
  38. P.x := P.x - Fix.x;
  39. P.y := P.y - Fix.y;
  40. result.x := Round(p.x*cosinus + p.y*sinus) + fix.x ;
  41. result.y := Round(-p.x*sinus + p.y*cosinus) + Fix.y;
  42. end;
  43. procedure DrawRotatedEllipse(
  44. ADest: TFPCustomCanvas;
  45. CurEllipse: TvEllipse;
  46. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  47. var
  48. PointList: array[0..6] of TPoint;
  49. f: TPoint;
  50. dk, x1, x2, y1, y2: Integer;
  51. {$ifdef USE_LCL_CANVAS}
  52. ALCLDest: TCanvas absolute ADest;
  53. {$endif}
  54. begin
  55. {$ifdef USE_LCL_CANVAS}
  56. CurEllipse.CalculateBoundingRectangle();
  57. x1 := CurEllipse.BoundingRect.Left;
  58. x2 := CurEllipse.BoundingRect.Right;
  59. y1 := CurEllipse.BoundingRect.Top;
  60. y2 := CurEllipse.BoundingRect.Bottom;
  61. dk := Round(0.654 * Abs(y2-y1));
  62. f.x := Round(CurEllipse.X);
  63. f.y := Round(CurEllipse.Y - 1);
  64. PointList[0] := Rotate2DPoint(Point(x1, f.y), f, CurEllipse.Angle) ; // Startpoint
  65. PointList[1] := Rotate2DPoint(Point(x1, f.y - dk), f, CurEllipse.Angle);
  66. //Controlpoint of Startpoint first part
  67. PointList[2] := Rotate2DPoint(Point(x2- 1, f.y - dk), f, CurEllipse.Angle);
  68. //Controlpoint of secondpoint first part
  69. PointList[3] := Rotate2DPoint(Point(x2 -1 , f.y), f, CurEllipse.Angle);
  70. // Firstpoint of secondpart
  71. PointList[4] := Rotate2DPoint(Point(x2-1 , f.y + dk), f, CurEllipse.Angle);
  72. // Controllpoint of secondpart firstpoint
  73. PointList[5] := Rotate2DPoint(Point(x1, f.y + dk), f, CurEllipse.Angle);
  74. // Conrollpoint of secondpart endpoint
  75. PointList[6] := PointList[0]; // Endpoint of
  76. // Back to the startpoint
  77. ALCLDest.PolyBezier(Pointlist[0]);
  78. {$endif}
  79. end;
  80. {@@
  81. This function draws a FPVectorial vectorial image to a TFPCustomCanvas
  82. descendent, such as TCanvas from the LCL.
  83. Be careful that by default this routine does not execute coordinate transformations,
  84. and that FPVectorial works with a start point in the bottom-left corner, with
  85. the X growing to the right and the Y growing to the top. This will result in
  86. an image in TFPCustomCanvas mirrored in the Y axis in relation with the document
  87. as seen in a PDF viewer, for example. This can be easily changed with the
  88. provided parameters. To have the standard view of an image viewer one could
  89. use this function like this:
  90. DrawFPVectorialToCanvas(ASource, ADest, 0, ASource.Height, 1.0, -1.0);
  91. }
  92. procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage;
  93. ADest: TFPCustomCanvas;
  94. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  95. var
  96. i: Integer;
  97. CurEntity: TvEntity;
  98. begin
  99. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  100. WriteLn(':>DrawFPVectorialToCanvas');
  101. {$endif}
  102. for i := 0 to ASource.GetEntitiesCount - 1 do
  103. begin
  104. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  105. Write(Format('[Path] ID=%d', [i]));
  106. {$endif}
  107. CurEntity := ASource.GetEntity(i);
  108. if CurEntity is TPath then DrawFPVPathToCanvas(ASource, TPath(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY)
  109. else if CurEntity is TvText then DrawFPVTextToCanvas(ASource, TvText(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY)
  110. else DrawFPVEntityToCanvas(ASource, CurEntity, ADest, ADestX, ADestY, AMulX, AMulY);
  111. end;
  112. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  113. WriteLn(':<DrawFPVectorialToCanvas');
  114. {$endif}
  115. end;
  116. procedure DrawFPVPathToCanvas(ASource: TvVectorialPage; CurPath: TPath;
  117. ADest: TFPCustomCanvas;
  118. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  119. function CoordToCanvasX(ACoord: Double): Integer;
  120. begin
  121. Result := Round(ADestX + AmulX * ACoord);
  122. end;
  123. function CoordToCanvasY(ACoord: Double): Integer;
  124. begin
  125. Result := Round(ADestY + AmulY * ACoord);
  126. end;
  127. var
  128. j, k: Integer;
  129. PosX, PosY: Double; // Not modified by ADestX, etc
  130. CoordX, CoordY: Integer;
  131. CurSegment: TPathSegment;
  132. Cur2DSegment: T2DSegment absolute CurSegment;
  133. Cur2DBSegment: T2DBezierSegment absolute CurSegment;
  134. // For bezier
  135. CurX, CurY: Integer; // Not modified by ADestX, etc
  136. CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4: Integer;
  137. CurveLength: Integer;
  138. t: Double;
  139. // For polygons
  140. Points: array of TPoint;
  141. // Clipping Region
  142. {$ifdef USE_LCL_CANVAS}
  143. ClipRegion, OldClipRegion: HRGN;
  144. ACanvas: TCanvas absolute ADest;
  145. {$endif}
  146. begin
  147. PosX := 0;
  148. PosY := 0;
  149. ADest.Brush.Style := bsClear;
  150. ADest.MoveTo(ADestX, ADestY);
  151. // Set the path Pen and Brush options
  152. ADest.Pen.Style := CurPath.Pen.Style;
  153. ADest.Pen.Width := Round(CurPath.Pen.Width * AMulX);
  154. if ADest.Pen.Width < 1 then ADest.Pen.Width := 1;
  155. ADest.Pen.FPColor := CurPath.Pen.Color;
  156. ADest.Brush.FPColor := CurPath.Brush.Color;
  157. // Prepare the Clipping Region, if any
  158. {$ifdef USE_CANVAS_CLIP_REGION}
  159. if CurPath.ClipPath <> nil then
  160. begin
  161. OldClipRegion := LCLIntf.CreateEmptyRegion();
  162. GetClipRgn(ACanvas.Handle, OldClipRegion);
  163. ClipRegion := ConvertPathToRegion(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
  164. SelectClipRgn(ACanvas.Handle, ClipRegion);
  165. DeleteObject(ClipRegion);
  166. // debug info
  167. {$ifdef DEBUG_CANVAS_CLIP_REGION}
  168. ConvertPathToPoints(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY, Points);
  169. ACanvas.Polygon(Points);
  170. {$endif}
  171. end;
  172. {$endif}
  173. //
  174. // For solid paths, draw a polygon for the main internal area
  175. //
  176. if CurPath.Brush.Style <> bsClear then
  177. begin
  178. CurPath.PrepareForSequentialReading;
  179. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  180. Write(' Solid Path Internal Area');
  181. {$endif}
  182. ADest.Brush.Style := CurPath.Brush.Style;
  183. SetLength(Points, CurPath.Len);
  184. for j := 0 to CurPath.Len - 1 do
  185. begin
  186. //WriteLn('j = ', j);
  187. CurSegment := TPathSegment(CurPath.Next());
  188. CoordX := CoordToCanvasX(Cur2DSegment.X);
  189. CoordY := CoordToCanvasY(Cur2DSegment.Y);
  190. Points[j].X := CoordX;
  191. Points[j].Y := CoordY;
  192. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  193. Write(Format(' P%d,%d', [CoordY, CoordY]));
  194. {$endif}
  195. end;
  196. ADest.Polygon(Points);
  197. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  198. Write(' Now the details ');
  199. {$endif}
  200. end;
  201. //
  202. // For other paths, draw more carefully
  203. //
  204. CurPath.PrepareForSequentialReading;
  205. for j := 0 to CurPath.Len - 1 do
  206. begin
  207. //WriteLn('j = ', j);
  208. CurSegment := TPathSegment(CurPath.Next());
  209. case CurSegment.SegmentType of
  210. stMoveTo:
  211. begin
  212. CoordX := CoordToCanvasX(Cur2DSegment.X);
  213. CoordY := CoordToCanvasY(Cur2DSegment.Y);
  214. ADest.MoveTo(CoordX, CoordY);
  215. PosX := Cur2DSegment.X;
  216. PosY := Cur2DSegment.Y;
  217. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  218. Write(Format(' M%d,%d', [CoordY, CoordY]));
  219. {$endif}
  220. end;
  221. // This element can override temporarely the Pen
  222. st2DLineWithPen:
  223. begin
  224. ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color;
  225. CoordX := CoordToCanvasX(PosX);
  226. CoordY := CoordToCanvasY(PosY);
  227. CoordX2 := CoordToCanvasX(Cur2DSegment.X);
  228. CoordY2 := CoordToCanvasY(Cur2DSegment.Y);
  229. ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
  230. PosX := Cur2DSegment.X;
  231. PosY := Cur2DSegment.Y;
  232. ADest.Pen.FPColor := CurPath.Pen.Color;
  233. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  234. Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
  235. {$endif}
  236. end;
  237. st2DLine, st3DLine:
  238. begin
  239. CoordX := CoordToCanvasX(PosX);
  240. CoordY := CoordToCanvasY(PosY);
  241. CoordX2 := CoordToCanvasX(Cur2DSegment.X);
  242. CoordY2 := CoordToCanvasY(Cur2DSegment.Y);
  243. ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
  244. PosX := Cur2DSegment.X;
  245. PosY := Cur2DSegment.Y;
  246. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  247. Write(Format(' L%d,%d', [CoordX, CoordY]));
  248. {$endif}
  249. end;
  250. { To draw a bezier we need to divide the interval in parts and make
  251. lines between this parts }
  252. st2DBezier, st3DBezier:
  253. begin
  254. CoordX := CoordToCanvasX(PosX);
  255. CoordY := CoordToCanvasY(PosY);
  256. CoordX2 := CoordToCanvasX(Cur2DBSegment.X2);
  257. CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2);
  258. CoordX3 := CoordToCanvasX(Cur2DBSegment.X3);
  259. CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3);
  260. CoordX4 := CoordToCanvasX(Cur2DBSegment.X);
  261. CoordY4 := CoordToCanvasY(Cur2DBSegment.Y);
  262. SetLength(Points, 0);
  263. AddBezierToPoints(
  264. Make2DPoint(CoordX, CoordY),
  265. Make2DPoint(CoordX2, CoordY2),
  266. Make2DPoint(CoordX3, CoordY3),
  267. Make2DPoint(CoordX4, CoordY4),
  268. Points
  269. );
  270. ADest.Brush.Style := CurPath.Brush.Style;
  271. if Length(Points) >= 3 then
  272. ADest.Polygon(Points);
  273. PosX := Cur2DSegment.X;
  274. PosY := Cur2DSegment.Y;
  275. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  276. Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
  277. [CoordToCanvasX(PosX), CoordToCanvasY(PosY),
  278. CoordToCanvasX(Cur2DBSegment.X2), CoordToCanvasY(Cur2DBSegment.Y2),
  279. CoordToCanvasX(Cur2DBSegment.X3), CoordToCanvasY(Cur2DBSegment.Y3),
  280. CoordToCanvasX(Cur2DBSegment.X), CoordToCanvasY(Cur2DBSegment.Y)]));
  281. {$endif}
  282. end;
  283. end;
  284. end;
  285. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  286. WriteLn('');
  287. {$endif}
  288. // Restores the previous Clip Region
  289. {$ifdef USE_CANVAS_CLIP_REGION}
  290. if CurPath.ClipPath <> nil then
  291. begin
  292. SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
  293. end;
  294. {$endif}
  295. end;
  296. procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity;
  297. ADest: TFPCustomCanvas;
  298. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  299. function CoordToCanvasX(ACoord: Double): Integer;
  300. begin
  301. Result := Round(ADestX + AmulX * ACoord);
  302. end;
  303. function CoordToCanvasY(ACoord: Double): Integer;
  304. begin
  305. Result := Round(ADestY + AmulY * ACoord);
  306. end;
  307. var
  308. i: Integer;
  309. {$ifdef USE_LCL_CANVAS}
  310. ALCLDest: TCanvas;
  311. {$endif}
  312. // For entities
  313. CurCircle: TvCircle;
  314. CurEllipse: TvEllipse;
  315. //
  316. CurArc: TvCircularArc;
  317. FinalStartAngle, FinalEndAngle: double;
  318. BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
  319. IntStartAngle, IntAngleLength, IntTmp: Integer;
  320. //
  321. CurDim: TvAlignedDimension;
  322. Points: array of TPoint;
  323. UpperDim, LowerDim: T3DPoint;
  324. begin
  325. {$ifdef USE_LCL_CANVAS}
  326. ALCLDest := TCanvas(ADest);
  327. {$endif}
  328. ADest.Brush.Style := CurEntity.Brush.Style;
  329. ADest.Pen.Style := CurEntity.Pen.Style;
  330. ADest.Pen.FPColor := CurEntity.Pen.Color;
  331. ADest.Brush.FPColor := CurEntity.Brush.Color;
  332. if CurEntity is TvCircle then
  333. begin
  334. CurCircle := CurEntity as TvCircle;
  335. ADest.Ellipse(
  336. CoordToCanvasX(CurCircle.X - CurCircle.Radius),
  337. CoordToCanvasY(CurCircle.Y - CurCircle.Radius),
  338. CoordToCanvasX(CurCircle.X + CurCircle.Radius),
  339. CoordToCanvasY(CurCircle.Y + CurCircle.Radius)
  340. );
  341. end
  342. else if CurEntity is TvEllipse then
  343. begin
  344. CurEllipse := CurEntity as TvEllipse;
  345. DrawRotatedEllipse(ADest, CurEllipse);
  346. end
  347. else if CurEntity is TvCircularArc then
  348. begin
  349. CurArc := CurEntity as TvCircularArc;
  350. {$ifdef USE_LCL_CANVAS}
  351. // ToDo: Consider a X axis inversion
  352. // If the Y axis is inverted, then we need to mirror our angles as well
  353. BoundsLeft := CoordToCanvasX(CurArc.X - CurArc.Radius);
  354. BoundsTop := CoordToCanvasY(CurArc.Y - CurArc.Radius);
  355. BoundsRight := CoordToCanvasX(CurArc.X + CurArc.Radius);
  356. BoundsBottom := CoordToCanvasY(CurArc.Y + CurArc.Radius);
  357. {if AMulY > 0 then
  358. begin}
  359. FinalStartAngle := CurArc.StartAngle;
  360. FinalEndAngle := CurArc.EndAngle;
  361. {end
  362. else // AMulY is negative
  363. begin
  364. // Inverting the angles generates the correct result for Y axis inversion
  365. if CurArc.EndAngle = 0 then FinalStartAngle := 0
  366. else FinalStartAngle := 360 - 1* CurArc.EndAngle;
  367. if CurArc.StartAngle = 0 then FinalEndAngle := 0
  368. else FinalEndAngle := 360 - 1* CurArc.StartAngle;
  369. end;}
  370. IntStartAngle := Round(16*FinalStartAngle);
  371. IntAngleLength := Round(16*(FinalEndAngle - FinalStartAngle));
  372. // On Gtk2 and Carbon, the Left really needs to be to the Left of the Right position
  373. // The same for the Top and Bottom
  374. // On Windows it works fine either way
  375. // On Gtk2 if the positions are inverted then the arcs are screwed up
  376. // In Carbon if the positions are inverted, then the arc is inverted
  377. if BoundsLeft > BoundsRight then
  378. begin
  379. IntTmp := BoundsLeft;
  380. BoundsLeft := BoundsRight;
  381. BoundsRight := IntTmp;
  382. end;
  383. if BoundsTop > BoundsBottom then
  384. begin
  385. IntTmp := BoundsTop;
  386. BoundsTop := BoundsBottom;
  387. BoundsBottom := IntTmp;
  388. end;
  389. // Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer);
  390. {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
  391. // WriteLn(Format('Drawing Arc Center=%f,%f Radius=%f StartAngle=%f AngleLength=%f',
  392. // [CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16]));
  393. {$endif}
  394. ADest.Pen.FPColor := CurArc.Pen.Color;
  395. ALCLDest.Arc(
  396. BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
  397. IntStartAngle, IntAngleLength
  398. );
  399. ADest.Pen.FPColor := colBlack;
  400. // Debug info
  401. // {$define FPVECTORIALDEBUG}
  402. // {$ifdef FPVECTORIALDEBUG}
  403. // WriteLn(Format('Drawing Arc x1y1=%d,%d x2y2=%d,%d start=%d end=%d',
  404. // [BoundsLeft, BoundsTop, BoundsRight, BoundsBottom, IntStartAngle, IntAngleLength]));
  405. // {$endif}
  406. { ADest.TextOut(CoordToCanvasX(CurArc.CenterX), CoordToCanvasY(CurArc.CenterY),
  407. Format('R=%d S=%d L=%d', [Round(CurArc.Radius*AMulX), Round(FinalStartAngle),
  408. Abs(Round((FinalEndAngle - FinalStartAngle)))]));
  409. ADest.Pen.Color := TColor($DDDDDD);
  410. ADest.Rectangle(
  411. BoundsLeft, BoundsTop, BoundsRight, BoundsBottom);
  412. ADest.Pen.Color := clBlack;}
  413. {$endif}
  414. end
  415. else if CurEntity is TvAlignedDimension then
  416. begin
  417. CurDim := CurEntity as TvAlignedDimension;
  418. //
  419. // Draws this shape:
  420. // vertical horizontal
  421. // ___
  422. // | | or ---| X cm
  423. // | --|
  424. // Which marks the dimension
  425. ADest.MoveTo(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y));
  426. ADest.LineTo(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y));
  427. ADest.LineTo(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y));
  428. ADest.LineTo(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y));
  429. // Now the arrows
  430. // horizontal
  431. SetLength(Points, 3);
  432. if CurDim.DimensionRight.Y = CurDim.DimensionLeft.Y then
  433. begin
  434. ADest.Brush.FPColor := colBlack;
  435. ADest.Brush.Style := bsSolid;
  436. // Left arrow
  437. Points[0] := Point(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y));
  438. Points[1] := Point(Points[0].X + 7, Points[0].Y - 3);
  439. Points[2] := Point(Points[0].X + 7, Points[0].Y + 3);
  440. ADest.Polygon(Points);
  441. // Right arrow
  442. Points[0] := Point(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y));
  443. Points[1] := Point(Points[0].X - 7, Points[0].Y - 3);
  444. Points[2] := Point(Points[0].X - 7, Points[0].Y + 3);
  445. ADest.Polygon(Points);
  446. ADest.Brush.Style := bsClear;
  447. // Dimension text
  448. Points[0].X := CoordToCanvasX((CurDim.DimensionLeft.X+CurDim.DimensionRight.X)/2);
  449. Points[0].Y := CoordToCanvasY(CurDim.DimensionLeft.Y);
  450. LowerDim.X := CurDim.DimensionRight.X-CurDim.DimensionLeft.X;
  451. ADest.Font.Size := 10;
  452. ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [LowerDim.X]));
  453. end
  454. else
  455. begin
  456. ADest.Brush.FPColor := colBlack;
  457. ADest.Brush.Style := bsSolid;
  458. // There is no upper/lower preference for DimensionLeft/Right, so we need to check
  459. if CurDim.DimensionLeft.Y > CurDim.DimensionRight.Y then
  460. begin
  461. UpperDim := CurDim.DimensionLeft;
  462. LowerDim := CurDim.DimensionRight;
  463. end
  464. else
  465. begin
  466. UpperDim := CurDim.DimensionRight;
  467. LowerDim := CurDim.DimensionLeft;
  468. end;
  469. // Upper arrow
  470. Points[0] := Point(CoordToCanvasX(UpperDim.X), CoordToCanvasY(UpperDim.Y));
  471. Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y - Round(AMulY*3));
  472. Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y - Round(AMulY*3));
  473. ADest.Polygon(Points);
  474. // Lower arrow
  475. Points[0] := Point(CoordToCanvasX(LowerDim.X), CoordToCanvasY(LowerDim.Y));
  476. Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y + Round(AMulY*3));
  477. Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y + Round(AMulY*3));
  478. ADest.Polygon(Points);
  479. ADest.Brush.Style := bsClear;
  480. // Dimension text
  481. Points[0].X := CoordToCanvasX(CurDim.DimensionLeft.X);
  482. Points[0].Y := CoordToCanvasY((CurDim.DimensionLeft.Y+CurDim.DimensionRight.Y)/2);
  483. LowerDim.Y := CurDim.DimensionRight.Y-CurDim.DimensionLeft.Y;
  484. if LowerDim.Y < 0 then LowerDim.Y := -1 * LowerDim.Y;
  485. ADest.Font.Size := 10;
  486. ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [LowerDim.Y]));
  487. end;
  488. SetLength(Points, 0);
  489. { // Debug info
  490. ADest.TextOut(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y), 'BR');
  491. ADest.TextOut(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y), 'DR');
  492. ADest.TextOut(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y), 'DL');
  493. ADest.TextOut(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y), 'BL');}
  494. end;
  495. end;
  496. procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText;
  497. ADest: TFPCustomCanvas;
  498. ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
  499. function CoordToCanvasX(ACoord: Double): Integer;
  500. begin
  501. Result := Round(ADestX + AmulX * ACoord);
  502. end;
  503. function CoordToCanvasY(ACoord: Double): Integer;
  504. begin
  505. Result := Round(ADestY + AmulY * ACoord);
  506. end;
  507. var
  508. i: Integer;
  509. {$ifdef USE_LCL_CANVAS}
  510. ALCLDest: TCanvas;
  511. {$endif}
  512. //
  513. LowerDim: T3DPoint;
  514. begin
  515. {$ifdef USE_LCL_CANVAS}
  516. ALCLDest := TCanvas(ADest);
  517. {$endif}
  518. ADest.Font.Size := Round(AmulX * CurText.Font.Size);
  519. ADest.Pen.Style := psSolid;
  520. ADest.Pen.FPColor := colBlack;
  521. ADest.Brush.Style := bsClear;
  522. {$ifdef USE_LCL_CANVAS}
  523. ALCLDest.Font.Orientation := Round(CurText.Font.Orientation * 16);
  524. {$endif}
  525. // TvText supports multiple lines
  526. for i := 0 to CurText.Value.Count - 1 do
  527. begin
  528. if CurText.Font.Size = 0 then LowerDim.Y := CurText.Y - 12 * (i + 1)
  529. else LowerDim.Y := CurText.Y - CurText.Font.Size * (i + 1);
  530. ADest.TextOut(CoordToCanvasX(CurText.X), CoordToCanvasY(LowerDim.Y), CurText.Value.Strings[i]);
  531. end;
  532. end;
  533. end.