← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/fpvectorial/fpvtocanvas.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/fpvectorial/fpvtocanvas.pas
 
1
unit fpvtocanvas;
 
2
 
 
3
{$mode objfpc}{$H+}
 
4
 
 
5
interface
 
6
 
 
7
{$define USE_LCL_CANVAS}
 
8
{$ifdef USE_LCL_CANVAS}
 
9
  {$define USE_CANVAS_CLIP_REGION}
 
10
  {.$define DEBUG_CANVAS_CLIP_REGION}
 
11
{$endif}
 
12
{$ifndef Windows}
 
13
{.$define FPVECTORIAL_TOCANVAS_DEBUG}
 
14
{$endif}
 
15
 
 
16
uses
 
17
  Classes, SysUtils, Math,
 
18
  {$ifdef USE_LCL_CANVAS}
 
19
  Graphics, LCLIntf, LCLType,
 
20
  {$endif}
 
21
  fpcanvas,
 
22
  fpimage,
 
23
  fpvectorial, fpvutils;
 
24
 
 
25
procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage;
 
26
  ADest: TFPCustomCanvas;
 
27
  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
28
procedure DrawFPVPathToCanvas(ASource: TvVectorialPage; CurPath: TPath;
 
29
  ADest: TFPCustomCanvas;
 
30
  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
31
procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity;
 
32
  ADest: TFPCustomCanvas;
 
33
  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
34
procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText;
 
35
  ADest: TFPCustomCanvas;
 
36
  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
37
 
 
38
implementation
 
39
 
 
40
{@@
 
41
  This function draws a FPVectorial vectorial image to a TFPCustomCanvas
 
42
  descendent, such as TCanvas from the LCL.
 
43
 
 
44
  Be careful that by default this routine does not execute coordinate transformations,
 
45
  and that FPVectorial works with a start point in the bottom-left corner, with
 
46
  the X growing to the right and the Y growing to the top. This will result in
 
47
  an image in TFPCustomCanvas mirrored in the Y axis in relation with the document
 
48
  as seen in a PDF viewer, for example. This can be easily changed with the
 
49
  provided parameters. To have the standard view of an image viewer one could
 
50
  use this function like this:
 
51
 
 
52
  DrawFPVectorialToCanvas(ASource, ADest, 0, ASource.Height, 1.0, -1.0);
 
53
}
 
54
procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage;
 
55
  ADest: TFPCustomCanvas;
 
56
  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
57
var
 
58
  i: Integer;
 
59
  CurEntity: TvEntity;
 
60
begin
 
61
  {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
62
  WriteLn(':>DrawFPVectorialToCanvas');
 
63
  {$endif}
 
64
 
 
65
  for i := 0 to ASource.GetEntitiesCount - 1 do
 
66
  begin
 
67
    {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
68
    Write(Format('[Path] ID=%d', [i]));
 
69
    {$endif}
 
70
 
 
71
    CurEntity := ASource.GetEntity(i);
 
72
 
 
73
    if CurEntity is TPath then DrawFPVPathToCanvas(ASource, TPath(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY)
 
74
    else if CurEntity is TvText then DrawFPVTextToCanvas(ASource, TvText(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY)
 
75
    else DrawFPVEntityToCanvas(ASource, CurEntity, ADest, ADestX, ADestY, AMulX, AMulY);
 
76
  end;
 
77
 
 
78
  {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
79
  WriteLn(':<DrawFPVectorialToCanvas');
 
80
  {$endif}
 
81
end;
 
82
 
 
83
procedure DrawFPVPathToCanvas(ASource: TvVectorialPage; CurPath: TPath;
 
84
  ADest: TFPCustomCanvas;
 
85
  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
86
 
 
87
  function CoordToCanvasX(ACoord: Double): Integer;
 
88
  begin
 
89
    Result := Round(ADestX + AmulX * ACoord);
 
90
  end;
 
91
 
 
92
  function CoordToCanvasY(ACoord: Double): Integer;
 
93
  begin
 
94
    Result := Round(ADestY + AmulY * ACoord);
 
95
  end;
 
96
 
 
97
var
 
98
  j, k: Integer;
 
99
  PosX, PosY: Double; // Not modified by ADestX, etc
 
100
  CoordX, CoordY: Integer;
 
101
  CurSegment: TPathSegment;
 
102
  Cur2DSegment: T2DSegment absolute CurSegment;
 
103
  Cur2DBSegment: T2DBezierSegment absolute CurSegment;
 
104
  // For bezier
 
105
  CurX, CurY: Integer; // Not modified by ADestX, etc
 
106
  CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4: Integer;
 
107
  CurveLength: Integer;
 
108
  t: Double;
 
109
  // For polygons
 
110
  Points: array of TPoint;
 
111
  // Clipping Region
 
112
  {$ifdef USE_LCL_CANVAS}
 
113
  ClipRegion, OldClipRegion: HRGN;
 
114
  ACanvas: TCanvas absolute ADest;
 
115
  {$endif}
 
116
begin
 
117
  PosX := 0;
 
118
  PosY := 0;
 
119
  ADest.Brush.Style := bsClear;
 
120
 
 
121
  ADest.MoveTo(ADestX, ADestY);
 
122
 
 
123
  // Set the path Pen and Brush options
 
124
  ADest.Pen.Style := CurPath.Pen.Style;
 
125
  ADest.Pen.Width := Round(CurPath.Pen.Width * AMulX);
 
126
  if ADest.Pen.Width < 1 then ADest.Pen.Width := 1;
 
127
  ADest.Pen.FPColor := CurPath.Pen.Color;
 
128
  ADest.Brush.FPColor := CurPath.Brush.Color;
 
129
 
 
130
  // Prepare the Clipping Region, if any
 
131
  {$ifdef USE_CANVAS_CLIP_REGION}
 
132
  if CurPath.ClipPath <> nil then
 
133
  begin
 
134
    OldClipRegion := LCLIntf.CreateEmptyRegion();
 
135
    GetClipRgn(ACanvas.Handle, OldClipRegion);
 
136
    ClipRegion := ConvertPathToRegion(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
 
137
    SelectClipRgn(ACanvas.Handle, ClipRegion);
 
138
    DeleteObject(ClipRegion);
 
139
    // debug info
 
140
    {$ifdef DEBUG_CANVAS_CLIP_REGION}
 
141
    ConvertPathToPoints(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY, Points);
 
142
    ACanvas.Polygon(Points);
 
143
    {$endif}
 
144
  end;
 
145
  {$endif}
 
146
 
 
147
  //
 
148
  // For solid paths, draw a polygon for the main internal area
 
149
  //
 
150
  if CurPath.Brush.Style <> bsClear then
 
151
  begin
 
152
    CurPath.PrepareForSequentialReading;
 
153
 
 
154
    {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
155
    Write(' Solid Path Internal Area');
 
156
    {$endif}
 
157
    ADest.Brush.Style := CurPath.Brush.Style;
 
158
 
 
159
    SetLength(Points, CurPath.Len);
 
160
 
 
161
    for j := 0 to CurPath.Len - 1 do
 
162
    begin
 
163
      //WriteLn('j = ', j);
 
164
      CurSegment := TPathSegment(CurPath.Next());
 
165
 
 
166
      CoordX := CoordToCanvasX(Cur2DSegment.X);
 
167
      CoordY := CoordToCanvasY(Cur2DSegment.Y);
 
168
 
 
169
      Points[j].X := CoordX;
 
170
      Points[j].Y := CoordY;
 
171
 
 
172
      {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
173
      Write(Format(' P%d,%d', [CoordY, CoordY]));
 
174
      {$endif}
 
175
    end;
 
176
 
 
177
    ADest.Polygon(Points);
 
178
 
 
179
    {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
180
    Write(' Now the details ');
 
181
    {$endif}
 
182
  end;
 
183
 
 
184
  //
 
185
  // For other paths, draw more carefully
 
186
  //
 
187
  CurPath.PrepareForSequentialReading;
 
188
 
 
189
  for j := 0 to CurPath.Len - 1 do
 
190
  begin
 
191
    //WriteLn('j = ', j);
 
192
    CurSegment := TPathSegment(CurPath.Next());
 
193
 
 
194
    case CurSegment.SegmentType of
 
195
    stMoveTo:
 
196
    begin
 
197
      CoordX := CoordToCanvasX(Cur2DSegment.X);
 
198
      CoordY := CoordToCanvasY(Cur2DSegment.Y);
 
199
      ADest.MoveTo(CoordX, CoordY);
 
200
      PosX := Cur2DSegment.X;
 
201
      PosY := Cur2DSegment.Y;
 
202
      {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
203
      Write(Format(' M%d,%d', [CoordY, CoordY]));
 
204
      {$endif}
 
205
    end;
 
206
    // This element can override temporarely the Pen
 
207
    st2DLineWithPen:
 
208
    begin
 
209
      ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color;
 
210
 
 
211
      CoordX := CoordToCanvasX(PosX);
 
212
      CoordY := CoordToCanvasY(PosY);
 
213
      CoordX2 := CoordToCanvasX(Cur2DSegment.X);
 
214
      CoordY2 := CoordToCanvasY(Cur2DSegment.Y);
 
215
      ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
 
216
 
 
217
      PosX := Cur2DSegment.X;
 
218
      PosY := Cur2DSegment.Y;
 
219
 
 
220
      ADest.Pen.FPColor := CurPath.Pen.Color;
 
221
 
 
222
      {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
223
      Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
 
224
      {$endif}
 
225
    end;
 
226
    st2DLine, st3DLine:
 
227
    begin
 
228
      CoordX := CoordToCanvasX(PosX);
 
229
      CoordY := CoordToCanvasY(PosY);
 
230
      CoordX2 := CoordToCanvasX(Cur2DSegment.X);
 
231
      CoordY2 := CoordToCanvasY(Cur2DSegment.Y);
 
232
      ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
 
233
      PosX := Cur2DSegment.X;
 
234
      PosY := Cur2DSegment.Y;
 
235
      {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
236
      Write(Format(' L%d,%d', [CoordX, CoordY]));
 
237
      {$endif}
 
238
    end;
 
239
    { To draw a bezier we need to divide the interval in parts and make
 
240
      lines between this parts }
 
241
    st2DBezier, st3DBezier:
 
242
    begin
 
243
      CoordX := CoordToCanvasX(PosX);
 
244
      CoordY := CoordToCanvasY(PosY);
 
245
      CoordX2 := CoordToCanvasX(Cur2DBSegment.X2);
 
246
      CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2);
 
247
      CoordX3 := CoordToCanvasX(Cur2DBSegment.X3);
 
248
      CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3);
 
249
      CoordX4 := CoordToCanvasX(Cur2DBSegment.X);
 
250
      CoordY4 := CoordToCanvasY(Cur2DBSegment.Y);
 
251
      SetLength(Points, 0);
 
252
      AddBezierToPoints(
 
253
        Make2DPoint(CoordX, CoordY),
 
254
        Make2DPoint(CoordX2, CoordY2),
 
255
        Make2DPoint(CoordX3, CoordY3),
 
256
        Make2DPoint(CoordX4, CoordY4),
 
257
        Points
 
258
      );
 
259
 
 
260
      ADest.Brush.Style := CurPath.Brush.Style;
 
261
      if Length(Points) >= 3 then
 
262
        ADest.Polygon(Points);
 
263
 
 
264
      PosX := Cur2DSegment.X;
 
265
      PosY := Cur2DSegment.Y;
 
266
 
 
267
      {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
268
      Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
 
269
        [CoordToCanvasX(PosX), CoordToCanvasY(PosY),
 
270
         CoordToCanvasX(Cur2DBSegment.X2), CoordToCanvasY(Cur2DBSegment.Y2),
 
271
         CoordToCanvasX(Cur2DBSegment.X3), CoordToCanvasY(Cur2DBSegment.Y3),
 
272
         CoordToCanvasX(Cur2DBSegment.X), CoordToCanvasY(Cur2DBSegment.Y)]));
 
273
      {$endif}
 
274
    end;
 
275
    end;
 
276
  end;
 
277
  {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 
278
  WriteLn('');
 
279
  {$endif}
 
280
 
 
281
  // Restores the previous Clip Region
 
282
  {$ifdef USE_CANVAS_CLIP_REGION}
 
283
  if CurPath.ClipPath <> nil then
 
284
  begin
 
285
    SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
 
286
  end;
 
287
  {$endif}
 
288
end;
 
289
 
 
290
procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity;
 
291
  ADest: TFPCustomCanvas;
 
292
  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
293
 
 
294
  function CoordToCanvasX(ACoord: Double): Integer;
 
295
  begin
 
296
    Result := Round(ADestX + AmulX * ACoord);
 
297
  end;
 
298
 
 
299
  function CoordToCanvasY(ACoord: Double): Integer;
 
300
  begin
 
301
    Result := Round(ADestY + AmulY * ACoord);
 
302
  end;
 
303
 
 
304
var
 
305
  i: Integer;
 
306
  {$ifdef USE_LCL_CANVAS}
 
307
  ALCLDest: TCanvas;
 
308
  {$endif}
 
309
  // For entities
 
310
  CurCircle: TvCircle;
 
311
  CurEllipse: TvEllipse;
 
312
  //
 
313
  CurArc: TvCircularArc;
 
314
  FinalStartAngle, FinalEndAngle: double;
 
315
  BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
 
316
   IntStartAngle, IntAngleLength, IntTmp: Integer;
 
317
  //
 
318
  CurDim: TvAlignedDimension;
 
319
  Points: array of TPoint;
 
320
  UpperDim, LowerDim: T3DPoint;
 
321
begin
 
322
  {$ifdef USE_LCL_CANVAS}
 
323
  ALCLDest := TCanvas(ADest);
 
324
  {$endif}
 
325
 
 
326
  if CurEntity is TvEntityWithPenAndBrush then
 
327
  begin
 
328
    ADest.Brush.Style := (CurEntity as TvEntityWithPenAndBrush).Brush.Style;
 
329
    ADest.Brush.FPColor := (CurEntity as TvEntityWithPenAndBrush).Brush.Color;
 
330
  end;
 
331
  if CurEntity is TvEntityWithPen then
 
332
  begin
 
333
    ADest.Pen.Style := (CurEntity as TvEntityWithPen).Pen.Style;
 
334
    ADest.Pen.FPColor := (CurEntity as TvEntityWithPen).Pen.Color;
 
335
  end;
 
336
 
 
337
  if CurEntity is TvCircle then
 
338
  begin
 
339
    CurCircle := CurEntity as TvCircle;
 
340
    ADest.Ellipse(
 
341
      CoordToCanvasX(CurCircle.X - CurCircle.Radius),
 
342
      CoordToCanvasY(CurCircle.Y - CurCircle.Radius),
 
343
      CoordToCanvasX(CurCircle.X + CurCircle.Radius),
 
344
      CoordToCanvasY(CurCircle.Y + CurCircle.Radius)
 
345
      );
 
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
  else
 
496
    CurEntity.Render(ADest, ADestX, ADestY, AMulX, AMulY);
 
497
end;
 
498
 
 
499
procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText;
 
500
  ADest: TFPCustomCanvas;
 
501
  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
502
 
 
503
  function CoordToCanvasX(ACoord: Double): Integer;
 
504
  begin
 
505
    Result := Round(ADestX + AmulX * ACoord);
 
506
  end;
 
507
 
 
508
  function CoordToCanvasY(ACoord: Double): Integer;
 
509
  begin
 
510
    Result := Round(ADestY + AmulY * ACoord);
 
511
  end;
 
512
 
 
513
var
 
514
  i: Integer;
 
515
  {$ifdef USE_LCL_CANVAS}
 
516
  ALCLDest: TCanvas;
 
517
  {$endif}
 
518
  //
 
519
  LowerDim: T3DPoint;
 
520
begin
 
521
  {$ifdef USE_LCL_CANVAS}
 
522
  ALCLDest := TCanvas(ADest);
 
523
  {$endif}
 
524
 
 
525
  ADest.Font.Size := Round(AmulX * CurText.Font.Size);
 
526
  ADest.Pen.Style := psSolid;
 
527
  ADest.Pen.FPColor := colBlack;
 
528
  ADest.Brush.Style := bsClear;
 
529
  {$ifdef USE_LCL_CANVAS}
 
530
  ALCLDest.Font.Orientation := Round(CurText.Font.Orientation * 16);
 
531
  {$endif}
 
532
 
 
533
  // TvText supports multiple lines
 
534
  for i := 0 to CurText.Value.Count - 1 do
 
535
  begin
 
536
    if CurText.Font.Size = 0 then LowerDim.Y := CurText.Y - 12 * (i + 1)
 
537
    else LowerDim.Y := CurText.Y - CurText.Font.Size * (i + 1);
 
538
 
 
539
    ADest.TextOut(CoordToCanvasX(CurText.X), CoordToCanvasY(LowerDim.Y), CurText.Value.Strings[i]);
 
540
  end;
 
541
end;
 
542
 
 
543
end.
 
544