1 // SPDX-License-Identifier: GPL-3.0-only
2 unit LCVectorPolyShapes;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, Types, LCVectorOriginal, BGRABitmapTypes, BGRALayerOriginal,
10 BGRABitmap, BGRATransform, BGRAGradients, BGRAGraphics,
11 BGRASVGShapes, BGRASVGType, BGRAUnits, BGRAPath;
12
13 type
14 TArrowKind = (akNone, akTail, akTip, akNormal, akCut, akFlipped, akFlippedCut,
15 akTriangle, akTriangleBack1, akTriangleBack2,
16 akHollowTriangle, akHollowTriangleBack1, akHollowTriangleBack2);
17
18 const
19 errShapeNotHandled = 'Shape not handled';
20 ArrowKindToStr: array[TArrowKind] of string =
21 ('none', 'tail', 'tip', 'normal', 'cut', 'flipped', 'flipped-cut',
22 'triangle', 'triangle-back1', 'triangle-back2',
23 'hollow-triangle', 'hollow-triangle-back1', 'hollow-triangle-back2');
24 LineCapToStr: array[TPenEndCap] of string =
25 ('round','square','flat');
26
StrToArrowKindnull27 function StrToArrowKind(AStr: string): TArrowKind;
StrToLineCapnull28 function StrToLineCap(AStr: string): TPenEndCap;
29
30 type
31 TCustomPolypointShape = class;
32 TCustomPolypointPoint = record
33 coord: TPointF;
34 editorIndex: integer;
35 data: cardinal;
36 end;
37
38 { TCustomPolypointShapeDiff }
39
40 TCustomPolypointShapeDiff = class(TVectorShapeDiff)
41 protected
42 FStartPoints: array of TCustomPolypointPoint;
43 FStartClosed: boolean;
44 FStartArrowStartKind,FStartArrowEndKind: TArrowKind;
45 FStartArrowSize: TPointF;
46 FStartLineCap: TPenEndCap;
47 FEndPoints: array of TCustomPolypointPoint;
48 FEndClosed: boolean;
49 FEndArrowStartKind,FEndArrowEndKind: TArrowKind;
50 FEndArrowSize: TPointF;
51 FEndLineCap: TPenEndCap;
52 public
53 constructor Create(AStartShape: TVectorShape); override;
54 procedure ComputeDiff(AEndShape: TVectorShape); override;
55 procedure Apply(AStartShape: TVectorShape); override;
56 procedure Unapply(AEndShape: TVectorShape); override;
57 procedure Append(ADiff: TVectorShapeDiff); override;
IsIdentitynull58 function IsIdentity: boolean; override;
59 end;
60
61 { TCustomPolypointShape }
62
63 TCustomPolypointShape = class(TVectorShape)
64 private
65 FClosed: boolean;
GetHoverPointnull66 function GetHoverPoint: integer;
GetLineCapnull67 function GetLineCap: TPenEndCap;
GetPointnull68 function GetPoint(AIndex: integer): TPointF;
GetPointCountnull69 function GetPointCount: integer;
70 procedure SetArrowEndKind(AValue: TArrowKind);
71 procedure SetArrowSize(AValue: TPointF);
72 procedure SetArrowStartKind(AValue: TArrowKind);
73 procedure SetCenterPoint(AValue: TPointF);
74 procedure SetHoverCenter(AValue: boolean);
75 procedure SetHoverPoint(AValue: integer);
76 procedure SetLineCap(AValue: TPenEndCap);
77 procedure SetPoint(AIndex: integer; AValue: TPointF);
78 protected
79 FPoints: array of TCustomPolypointPoint;
80 FCenterPoint: TPointF;
81 FCenterPointEditorIndex: integer;
82 FCurPoint: integer;
83 FAddingPoint: boolean;
84 FMousePos: TPointF;
85 FHoverPoint: integer;
86 FHoverCenter: boolean;
87 FArrowStartKind,FArrowEndKind: TArrowKind;
88 FArrowSize: TPointF;
89 FViewMatrix, FViewMatrixInverse, FGridMatrix: TAffineMatrix;
90 procedure OnMovePoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
91 procedure OnMoveCenterPoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
92 procedure OnStartMove({%H-}ASender: TObject; APointIndex: integer; {%H-}AShift: TShiftState);
GetCurvenull93 function GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF; virtual;
GetPathnull94 function GetPath(AMatrix: TAffineMatrix): TBGRAPath; virtual;
95 procedure SetUsermode(AValue: TVectorShapeUsermode); override;
GetClosednull96 function GetClosed: boolean; virtual;
97 procedure SetClosed(AValue: boolean); virtual;
PointsEqualnull98 function PointsEqual(const APoint1, APoint2: TPointF): boolean;
99 procedure OnHoverPoint({%H-}ASender: TObject; APointIndex: integer); virtual;
100 procedure OnClickPoint({%H-}ASender: TObject; APointIndex: integer; {%H-}AShift: TShiftState); virtual;
101 procedure DoClickPoint({%H-}APointIndex: integer; {%H-}AShift: TShiftState); virtual;
CanMovePointsnull102 function CanMovePoints: boolean; virtual;
103 procedure InsertPointAuto(AShift: TShiftState);
ComputeStrokenull104 function ComputeStroke(APoints: ArrayOfTPointF; AClosed: boolean;
105 AStrokeMatrix: TAffineMatrix): ArrayOfTPointF; override;
GetLoopStartIndexnull106 function GetLoopStartIndex: integer;
GetLoopPointCountnull107 function GetLoopPointCount: integer;
GetIsFollowingMousenull108 function GetIsFollowingMouse: boolean; override;
109 public
110 constructor Create(AContainer: TVectorOriginal); override;
111 procedure Clear;
AddPointnull112 function AddPoint(const APoint: TPointF): integer; virtual;
RemovePointnull113 function RemovePoint(AIndex: integer): boolean;
114 procedure RemovePointRange(AFromIndex, AToIndexPlus1: integer);
115 procedure InsertPoint(AIndex: integer; APoint: TPointF);
GetPointBoundsnull116 function GetPointBounds(AMatrix: TAffineMatrix): TRectF;
117 procedure MouseMove({%H-}Shift: TShiftState; X, Y: single; var {%H-}ACursor: TOriginalEditorCursor; var AHandled: boolean); override;
118 procedure MouseDown(RightButton: boolean; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: single; var {%H-}ACursor: TOriginalEditorCursor; var AHandled: boolean); override;
119 procedure KeyDown({%H-}Shift: TShiftState; Key: TSpecialKey; var AHandled: boolean); override;
120 procedure QuickDefine(constref APoint1,APoint2: TPointF); override;
121 procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
122 procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
123 procedure ConfigureCustomEditor(AEditor: TBGRAOriginalEditor); override;
124 procedure TransformFrame(const AMatrix: TAffineMatrix); override;
Usermodesnull125 class function Usermodes: TVectorShapeUsermodes; override;
DefaultArrowSizenull126 class function DefaultArrowSize: TPointF;
127 property Points[AIndex:integer]: TPointF read GetPoint write SetPoint;
128 property PointCount: integer read GetPointCount;
129 property Closed: boolean read GetClosed write SetClosed;
130 property HoverPoint: integer read GetHoverPoint write SetHoverPoint;
131 property HoverCenter: boolean read FHoverCenter write SetHoverCenter;
132 property ArrowStartKind: TArrowKind read FArrowStartKind write SetArrowStartKind;
133 property ArrowEndKind: TArrowKind read FArrowEndKind write SetArrowEndKind;
134 property ArrowSize: TPointF read FArrowSize write SetArrowSize;
135 property LineCap: TPenEndCap read GetLineCap write SetLineCap;
136 property Center: TPointF read FCenterPoint write SetCenterPoint;
137 end;
138
139 { TPolylineShape }
140
141 TPolylineShape = class(TCustomPolypointShape)
142 public
Fieldsnull143 class function Fields: TVectorShapeFields; override;
144 procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override;
AppendToSVGnull145 function AppendToSVG(AContent: TSVGContent; ADefs: TSVGDefine): TSVGElement; override;
GetRenderBoundsnull146 function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions = []): TRectF; override;
PointInShapenull147 function PointInShape(APoint: TPointF): boolean; overload; override;
PointInShapenull148 function PointInShape(APoint: TPointF; ARadius: single): boolean; overload; override;
PointInBacknull149 function PointInBack(APoint: TPointF): boolean; overload; override;
PointInPennull150 function PointInPen(APoint: TPointF): boolean; overload; override;
GetIsSlownull151 function GetIsSlow(const {%H-}AMatrix: TAffineMatrix): boolean; override;
StorageClassNamenull152 class function StorageClassName: RawByteString; override;
153 end;
154
155 TCurveShape = class;
156
157 { TCurveShapeDiff }
158
159 TCurveShapeDiff = class(TVectorShapeDiff)
160 protected
161 FStartCosineAngle: single;
162 FStartSplineStyle: TSplineStyle;
163 FEndCosineAngle: single;
164 FEndSplineStyle: TSplineStyle;
165 public
166 constructor Create(AStartShape: TVectorShape); override;
167 procedure ComputeDiff(AEndShape: TVectorShape); override;
168 procedure Apply(AStartShape: TVectorShape); override;
169 procedure Unapply(AEndShape: TVectorShape); override;
170 procedure Append(ADiff: TVectorShapeDiff); override;
IsIdentitynull171 function IsIdentity: boolean; override;
172 end;
173
174 { TCurveShape }
175
176 TCurveShape = class(TPolylineShape)
177 private
178 FCosineAngle: single;
179 FSplineStyle: TSplineStyle;
GetCurveModenull180 function GetCurveMode(AIndex: integer): TEasyBezierCurveMode;
181 procedure SetCosineAngle(AValue: single);
182 procedure SetCurveMode(AIndex: integer; AValue: TEasyBezierCurveMode);
183 procedure SetSplineStyle(AValue: TSplineStyle);
184 protected
GetCurvenull185 function GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF; override;
GetPathnull186 function GetPath(AMatrix: TAffineMatrix): TBGRAPath; override;
CanMovePointsnull187 function CanMovePoints: boolean; override;
188 procedure DoClickPoint(APointIndex: integer; {%H-}AShift: TShiftState); override;
189 public
Usermodesnull190 class function Usermodes: TVectorShapeUsermodes; override;
191 constructor Create(AContainer: TVectorOriginal); override;
192 constructor CreateFrom(AContainer: TVectorOriginal; AShape: TVectorShape);
CanCreateFromnull193 class function CanCreateFrom(AShape: TVectorShape): boolean;
AddPointnull194 function AddPoint(const APoint: TPointF): integer; overload; override;
AddPointnull195 function AddPoint(const APoint: TPointF; AMode: TEasyBezierCurveMode): integer; overload;
196 procedure KeyPress(UTF8Key: string; var AHandled: boolean); override;
197 procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
198 procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
StorageClassNamenull199 class function StorageClassName: RawByteString; override;
200 property SplineStyle: TSplineStyle read FSplineStyle write SetSplineStyle;
201 property CurveMode[AIndex: integer]: TEasyBezierCurveMode read GetCurveMode write SetCurveMode;
202 property CosineAngle: single read FCosineAngle write SetCosineAngle;
203 end;
204
205 procedure ApplyArrowStyle(AArrow: TBGRACustomArrow; AStart: boolean; AKind: TArrowKind; ASize: TPointF);
206
207 implementation
208
209 uses BGRAPen, BGRAFillInfo, math, LCVectorialFill,
210 BGRAArrow, LCVectorRectShapes, LCResourceString;
211
StrToArrowKindnull212 function StrToArrowKind(AStr: string): TArrowKind;
213 var
214 ak: TArrowKind;
215 begin
216 for ak := low(TArrowKind) to high(TArrowKind) do
217 if CompareText(AStr, ArrowKindToStr[ak])=0 then exit(ak);
218 result := akNone;
219 end;
220
StrToLineCapnull221 function StrToLineCap(AStr: string): TPenEndCap;
222 var
223 ec: TPenEndCap;
224 begin
225 for ec := low(TPenEndCap) to high(TPenEndCap) do
226 if CompareText(AStr, LineCapToStr[ec])=0 then exit(ec);
227 result := pecRound;
228 end;
229
230 procedure ApplyArrowStyle(AArrow: TBGRACustomArrow; AStart: boolean; AKind: TArrowKind; ASize: TPointF);
231 var backOfs: single;
232 begin
233 backOfs := 0;
234 if (ASize.x = 0) or (ASize.y = 0) then AKind := akNone;
235 if AKind in[akTriangleBack1,akHollowTriangleBack1] then backOfs := 0.25;
236 if AKind in[akTriangleBack2,akHollowTriangleBack2] then backOfs := 0.50;
237 case AKind of
238 akTail: if AStart then AArrow.StartAsTail else AArrow.EndAsTail;
239 akTip: if AStart then AArrow.StartAsTriangle else AArrow.EndAsTriangle;
240 akNormal,akCut,akFlipped,akFlippedCut:
241 if AStart then AArrow.StartAsClassic(AKind in[akFlipped,akFlippedCut], AKind in[akCut,akFlippedCut])
242 else AArrow.EndAsClassic(AKind in[akFlipped,akFlippedCut], AKind in[akCut,akFlippedCut]);
243 akTriangle,akTriangleBack1,akTriangleBack2:
244 if AStart then AArrow.StartAsTriangle(backOfs) else AArrow.EndAsTriangle(backOfs);
245 akHollowTriangle,akHollowTriangleBack1,akHollowTriangleBack2:
246 if AStart then AArrow.StartAsTriangle(backOfs,False,True) else AArrow.EndAsTriangle(backOfs,False,True);
247 else if AStart then AArrow.StartAsNone else AArrow.EndAsNone;
248 end;
249 if (AKind = akTip) and not ((ASize.x = 0) or (ASize.y = 0)) then
250 ASize := ASize*(0.5/ASize.y);
251 if AStart then AArrow.StartSize := ASize else AArrow.EndSize := ASize;
252 end;
253
254 procedure IncludePointF(var ARectF: TRectF; APointF: TPointF);
255 begin
256 if APointF.x < ARectF.Left then ARectF.Left := APointF.x;
257 if APointF.x > ARectF.Right then ARectF.Right := APointF.x;
258 if APointF.y < ARectF.Top then ARectF.Top := APointF.y;
259 if APointF.y > ARectF.Bottom then ARectF.Bottom := APointF.y;
260 end;
261
GetPointsBoundsFnull262 function GetPointsBoundsF(const APoints: array of TPointF): TRectF;
263 var
264 i: Integer;
265 firstPoint: Boolean;
266 begin
267 result:= EmptyRectF;
268 firstPoint := true;
269 for i:= 0 to high(APoints) do
270 if not isEmptyPointF(APoints[i]) then
271 begin
272 if firstPoint then
273 begin
274 result.TopLeft := APoints[i];
275 result.BottomRight := APoints[i];
276 firstPoint := false;
277 end else
278 IncludePointF(result, APoints[i]);
279 end;
280 end;
281
282 { TCurveShapeDiff }
283
284 constructor TCurveShapeDiff.Create(AStartShape: TVectorShape);
285 begin
286 with (AStartShape as TCurveShape) do
287 begin
288 FStartCosineAngle:= FCosineAngle;
289 FStartSplineStyle:= FSplineStyle;
290 end;
291 end;
292
293 procedure TCurveShapeDiff.ComputeDiff(AEndShape: TVectorShape);
294 begin
295 with (AEndShape as TCurveShape) do
296 begin
297 FEndCosineAngle:= FCosineAngle;
298 FEndSplineStyle:= FSplineStyle;
299 end;
300 end;
301
302 procedure TCurveShapeDiff.Apply(AStartShape: TVectorShape);
303 begin
304 with (AStartShape as TCurveShape) do
305 begin
306 BeginUpdate;
307 FCosineAngle := FEndCosineAngle;
308 FSplineStyle := FEndSplineStyle;
309 EndUpdate;
310 end;
311 end;
312
313 procedure TCurveShapeDiff.Unapply(AEndShape: TVectorShape);
314 begin
315 with (AEndShape as TCurveShape) do
316 begin
317 BeginUpdate;
318 FCosineAngle := FStartCosineAngle;
319 FSplineStyle := FStartSplineStyle;
320 EndUpdate;
321 end;
322 end;
323
324 procedure TCurveShapeDiff.Append(ADiff: TVectorShapeDiff);
325 var
326 next: TCurveShapeDiff;
327 begin
328 next := ADiff as TCurveShapeDiff;
329 FEndCosineAngle:= next.FEndCosineAngle;
330 FEndSplineStyle:= next.FEndSplineStyle;
331 end;
332
IsIdentitynull333 function TCurveShapeDiff.IsIdentity: boolean;
334 begin
335 result := (FStartCosineAngle = FEndCosineAngle) and
336 (FStartSplineStyle = FEndSplineStyle);
337 end;
338
339 { TCustomPolypointShapeDiff }
340
341 constructor TCustomPolypointShapeDiff.Create(AStartShape: TVectorShape);
342 var
343 i: Integer;
344 begin
345 with (AStartShape as TCustomPolypointShape) do
346 begin
347 setlength(FStartPoints, length(FPoints));
348 for i := 0 to high(FPoints) do FStartPoints[i] := FPoints[i];
349 FStartClosed:= FClosed;
350 FStartArrowStartKind := FArrowStartKind;
351 FStartArrowEndKind:= FArrowEndKind;
352 FStartArrowSize:= FArrowSize;
353 FStartLineCap:= Stroker.LineCap;
354 end;
355 end;
356
357 procedure TCustomPolypointShapeDiff.ComputeDiff(AEndShape: TVectorShape);
358 var
359 i: Integer;
360 begin
361 with (AEndShape as TCustomPolypointShape) do
362 begin
363 setlength(FEndPoints, length(FPoints));
364 for i := 0 to high(FPoints) do FEndPoints[i] := FPoints[i];
365 FEndClosed:= FClosed;
366 FEndArrowStartKind := FArrowStartKind;
367 FEndArrowEndKind:= FArrowEndKind;
368 FEndArrowSize:= FArrowSize;
369 FEndLineCap:= Stroker.LineCap;
370 end;
371 end;
372
373 procedure TCustomPolypointShapeDiff.Apply(AStartShape: TVectorShape);
374 var
375 i: Integer;
376 begin
377 with (AStartShape as TCustomPolypointShape) do
378 begin
379 BeginUpdate;
380 setlength(FPoints, length(FEndPoints));
381 for i := 0 to high(FPoints) do FPoints[i] := FEndPoints[i];
382 FClosed := FEndClosed;
383 FArrowStartKind := FEndArrowStartKind;
384 FArrowEndKind := FEndArrowEndKind;
385 FArrowSize := FEndArrowSize;
386 Stroker.LineCap:= FEndLineCap;
387 EndUpdate;
388 end;
389 end;
390
391 procedure TCustomPolypointShapeDiff.Unapply(AEndShape: TVectorShape);
392 var
393 i: Integer;
394 begin
395 with (AEndShape as TCustomPolypointShape) do
396 begin
397 BeginUpdate;
398 setlength(FPoints, length(FStartPoints));
399 for i := 0 to high(FPoints) do FPoints[i] := FStartPoints[i];
400 FClosed := FStartClosed;
401 FArrowStartKind := FStartArrowStartKind;
402 FArrowEndKind := FStartArrowEndKind;
403 FArrowSize := FStartArrowSize;
404 Stroker.LineCap:= FStartLineCap;
405 EndUpdate;
406 end;
407 end;
408
409 procedure TCustomPolypointShapeDiff.Append(ADiff: TVectorShapeDiff);
410 var
411 next: TCustomPolypointShapeDiff;
412 i: Integer;
413 begin
414 next := ADiff as TCustomPolypointShapeDiff;
415 setlength(FEndPoints, length(next.FEndPoints));
416 for i := 0 to high(FEndPoints) do FEndPoints[i] := next.FEndPoints[i];
417 FEndClosed := next.FEndClosed;
418 FEndArrowStartKind := next.FEndArrowStartKind;
419 FEndArrowEndKind := next.FEndArrowEndKind;
420 FEndArrowSize := next.FEndArrowSize;
421 FEndLineCap:= next.FEndLineCap;
422 end;
423
IsIdentitynull424 function TCustomPolypointShapeDiff.IsIdentity: boolean;
425 var
426 i: Integer;
427 begin
428 result := (length(FStartPoints) = length(FEndPoints)) and
429 (FStartClosed = FEndClosed) and
430 (FStartArrowStartKind = FEndArrowStartKind) and
431 (FStartArrowEndKind = FEndArrowEndKind) and
432 (FStartArrowSize = FEndArrowSize) and
433 (FStartLineCap = FEndLineCap);
434 if result then
435 begin
436 for i := 0 to high(FStartPoints) do
437 if (FStartPoints[i].coord<>FEndPoints[i].coord) or
438 (FStartPoints[i].data<>FEndPoints[i].data) then
439 begin
440 result := false;
441 break;
442 end;
443 end;
444 end;
445
446 { TCustomPolypointShape }
447
GetClosednull448 function TCustomPolypointShape.GetClosed: boolean;
449 begin
450 result := FClosed;
451 end;
452
GetPointnull453 function TCustomPolypointShape.GetPoint(AIndex: integer): TPointF;
454 begin
455 if (AIndex < 0) or (AIndex >= length(FPoints)) then
456 raise ERangeError.Create(rsIndexOutOfBounds);
457 result := FPoints[AIndex].coord;
458 end;
459
GetLineCapnull460 function TCustomPolypointShape.GetLineCap: TPenEndCap;
461 begin
462 result := Stroker.LineCap;
463 end;
464
TCustomPolypointShape.GetHoverPointnull465 function TCustomPolypointShape.GetHoverPoint: integer;
466 begin
467 if (FHoverPoint >= 0) and (FHoverPoint < PointCount) and
468 not Points[FHoverPoint].IsEmpty then
469 result := FHoverPoint else result := -1;
470 end;
471
TCustomPolypointShape.GetPointCountnull472 function TCustomPolypointShape.GetPointCount: integer;
473 begin
474 result:= length(FPoints);
475 end;
476
477 procedure TCustomPolypointShape.SetArrowEndKind(AValue: TArrowKind);
478 begin
479 if FArrowEndKind=AValue then Exit;
480 BeginUpdate(TCustomPolypointShapeDiff);
481 FArrowEndKind:=AValue;
482 EndUpdate;
483 end;
484
485 procedure TCustomPolypointShape.SetArrowSize(AValue: TPointF);
486 begin
487 if FArrowSize=AValue then Exit;
488 BeginUpdate(TCustomPolypointShapeDiff);
489 FArrowSize:=AValue;
490 EndUpdate;
491 end;
492
493 procedure TCustomPolypointShape.SetArrowStartKind(AValue: TArrowKind);
494 begin
495 if FArrowStartKind=AValue then Exit;
496 BeginUpdate(TCustomPolypointShapeDiff);
497 FArrowStartKind:=AValue;
498 EndUpdate;
499 end;
500
501 procedure TCustomPolypointShape.SetCenterPoint(AValue: TPointF);
502 var
503 i: Integer;
504 delta: TPointF;
505 begin
506 if FCenterPoint=AValue then Exit;
507
508 BeginUpdate(TCustomPolypointShapeDiff);
509 delta := AValue - FCenterPoint;
510 for i := 0 to PointCount-1 do
511 Points[i] := Points[i]+delta;
512 if vsfBackFill in Fields then
513 BackFill.Transform(AffineMatrixTranslation(delta.x, delta.y));
514 if vsfPenFill in Fields then
515 PenFill.Transform(AffineMatrixTranslation(delta.x, delta.y));
516 FCenterPoint:=AValue;
517 EndUpdate;
518 end;
519
520 procedure TCustomPolypointShape.SetHoverCenter(AValue: boolean);
521 begin
522 if FHoverCenter=AValue then Exit;
523 BeginEditingUpdate;
524 if AValue then FHoverPoint := -1;
525 FHoverCenter:=AValue;
526 EndEditingUpdate;
527 end;
528
529 procedure TCustomPolypointShape.SetHoverPoint(AValue: integer);
530 begin
531 if (AValue < 0) or (AValue >= PointCount) or
532 Points[AValue].IsEmpty then AValue := -1;
533 if AValue <> FHoverPoint then
534 begin
535 BeginEditingUpdate;
536 FHoverPoint := AValue;
537 if AValue <> -1 then FHoverCenter:= false;
538 EndEditingUpdate;
539 end;
540 end;
541
542 procedure TCustomPolypointShape.SetLineCap(AValue: TPenEndCap);
543 begin
544 if Stroker.LineCap=AValue then Exit;
545 BeginUpdate(TCustomPolypointShapeDiff);
546 Stroker.LineCap:=AValue;
547 EndUpdate;
548 end;
549
550 procedure TCustomPolypointShape.SetClosed(AValue: boolean);
551 begin
552 if AValue = FClosed then exit;
553 BeginUpdate(TCustomPolypointShapeDiff);
554 FClosed := AValue;
555 EndUpdate;
556 end;
557
558 procedure TCustomPolypointShape.SetPoint(AIndex: integer; AValue: TPointF);
559 begin
560 if (AIndex < 0) or (AIndex > length(FPoints)) then
561 raise ERangeError.Create(rsIndexOutOfBounds);
562 BeginUpdate(TCustomPolypointShapeDiff);
563 if AIndex = length(FPoints) then
564 begin
565 setlength(FPoints, length(FPoints)+1);
566 FPoints[AIndex].coord := AValue;
567 FPoints[AIndex].editorIndex := -1;
568 FPoints[AIndex].data := 0;
569 end
570 else
571 FPoints[AIndex].coord := AValue;
572 EndUpdate;
573 end;
574
575 procedure TCustomPolypointShape.OnMovePoint(ASender: TObject; APrevCoord,
576 ANewCoord: TPointF; AShift: TShiftState);
577 begin
578 if FCurPoint = -1 then exit;
579 Points[FCurPoint] := ANewCoord;
580 end;
581
582 procedure TCustomPolypointShape.OnMoveCenterPoint(ASender: TObject; APrevCoord,
583 ANewCoord: TPointF; AShift: TShiftState);
584 begin
585 Center := ANewCoord;
586 end;
587
588 procedure TCustomPolypointShape.OnStartMove(ASender: TObject; APointIndex: integer;
589 AShift: TShiftState);
590 var
591 i: Integer;
592 begin
593 FCurPoint:= -1;
594 for i:= 0 to PointCount-1 do
595 if FPoints[i].editorIndex = APointIndex then
596 begin
597 FCurPoint:= i;
598 break;
599 end;
600 end;
601
TCustomPolypointShape.GetCurvenull602 function TCustomPolypointShape.GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF;
603 var
604 i: Integer;
605 m: TAffineMatrix;
606 begin
607 setlength(result, PointCount);
608 m:= MatrixForPixelCentered(AMatrix);
609 for i := 0 to PointCount-1 do
610 result[i] := m*Points[i];
611 end;
612
TCustomPolypointShape.GetPathnull613 function TCustomPolypointShape.GetPath(AMatrix: TAffineMatrix): TBGRAPath;
614 begin
615 result := TBGRAPath.Create(GetCurve(AMatrix));
616 end;
617
TCustomPolypointShape.Usermodesnull618 class function TCustomPolypointShape.Usermodes: TVectorShapeUsermodes;
619 begin
620 Result:= inherited Usermodes + [vsuCreate];
621 end;
622
TCustomPolypointShape.DefaultArrowSizenull623 class function TCustomPolypointShape.DefaultArrowSize: TPointF;
624 begin
625 result := PointF(2,2);
626 end;
627
628 procedure TCustomPolypointShape.SetUsermode(AValue: TVectorShapeUsermode);
629 var
630 add: Boolean;
631 begin
632 add := AValue = vsuCreate;
633 if add and (PointCount = 0) then exit;
634 if FAddingPoint and not add then
635 begin
636 if (PointCount>1) and PointsEqual(Points[PointCount-1],Points[PointCount-2]) then
637 RemovePoint(PointCount-1);
638 FAddingPoint:= add;
639 end else
640 if not FAddingPoint and add then
641 begin
642 if not isEmptyPointF(FMousePos) then
643 AddPoint(FMousePos)
644 else
645 AddPoint(Points[PointCount-1]);
646 FAddingPoint:= add;
647 end;
648 inherited SetUsermode(AValue);
649 end;
650
TCustomPolypointShape.PointsEqualnull651 function TCustomPolypointShape.PointsEqual(const APoint1, APoint2: TPointF
652 ): boolean;
653 begin
654 if isEmptyPointF(APoint1) then
655 exit(isEmptyPointF(APoint2))
656 else
657 if isEmptyPointF(APoint2) then exit(false)
658 else
659 exit((APoint1.x = APoint2.x) and (APoint1.y = APoint2.y));
660 end;
661
662 procedure TCustomPolypointShape.OnHoverPoint(ASender: TObject;
663 APointIndex: integer);
664 var
665 i, newHoverPoint: Integer;
666 begin
667 if APointIndex = FCenterPointEditorIndex then
668 begin
669 HoverCenter := true;
670 exit;
671 end;
672 newHoverPoint:= -1;
673 if APointIndex <> -1 then
674 begin
675 for i:= 0 to PointCount-1 do
676 if FPoints[i].editorIndex = APointIndex then
677 begin
678 newHoverPoint:= i;
679 break;
680 end;
681 end;
682 HoverPoint := newHoverPoint;
683 HoverCenter:= false;
684 end;
685
686 procedure TCustomPolypointShape.OnClickPoint(ASender: TObject;
687 APointIndex: integer; AShift: TShiftState);
688 var
689 i: Integer;
690 begin
691 if APointIndex <> -1 then
692 begin
693 for i:= 0 to PointCount-1 do
694 if FPoints[i].editorIndex = APointIndex then
695 begin
696 DoClickPoint(i, AShift);
697 break;
698 end;
699 end;
700 end;
701
702 procedure TCustomPolypointShape.DoClickPoint(APointIndex: integer;
703 AShift: TShiftState);
704 var
705 nb: Integer;
706 begin
707 if FAddingPoint and ((APointIndex = GetLoopStartIndex) or
708 ((APointIndex = PointCount-2) and (ssRight in AShift))) then
709 begin
710 nb := GetLoopPointCount;
711 if nb > 2 then
712 begin
713 BeginUpdate;
714 RemovePoint(PointCount-1);
715 if APointIndex < PointCount-2 then Closed := true;
716 EndUpdate;
717 UserMode := vsuEdit;
718 end else
719 begin
720 if GetLoopStartIndex = 0 then
721 Remove
722 else
723 begin
724 BeginUpdate;
725 while nb > 0 do
726 begin
727 RemovePoint(PointCount-1);
728 dec(nb);
729 end;
730 RemovePoint(PointCount-1); //remove separator
731 end;
732 end;
733 end;
734 end;
735
CanMovePointsnull736 function TCustomPolypointShape.CanMovePoints: boolean;
737 begin
738 result := true;
739 end;
740
741 procedure TCustomPolypointShape.InsertPointAuto(AShift: TShiftState);
742 var
743 i,j, loopStart: Integer;
744 bestSegmentIndex,bestPointIndex: integer;
745 bestSegmentDist,bestPointDist, segmentLen, segmentPos: single;
746 u, n, bestProjection: TPointF;
747 segmentDist: single;
748 isLooping: Boolean;
749 begin
750 if isEmptyPointF(FMousePos) then exit;
751
752 for i := 0 to PointCount-1 do
753 if (Points[i] = FMousePos) and not (FAddingPoint and (i = PointCount-1)) then exit;
754
755 bestSegmentIndex := -1;
756 bestSegmentDist := MaxSingle;
757 bestProjection := EmptyPointF;
758 loopStart := 0;
759 for i := 0 to PointCount-1 do
760 if FAddingPoint and (i >= PointCount-2) then break else
761 begin
762 if IsEmptyPointF(Points[i]) then
763 begin
764 loopStart := i+1;
765 continue;
766 end;
767 isLooping := (i = PointCount-1) or IsEmptyPointF(Points[i+1]);
768 if isLooping and not Closed then break;
769 if isLooping then
770 j := loopStart
771 else j := i+1;
772 u := Points[j] - Points[i];
773 segmentLen := VectLen(u);
774 if segmentLen > 0 then
775 begin
776 u *= 1/segmentLen;
777 segmentPos := (FMousePos-Points[i])*u;
778 if (segmentPos > 0) and (segmentPos< segmentLen) then
779 begin
780 n := PointF(u.y,-u.x);
781 segmentDist := abs((FMousePos-Points[i])*n);
782 if segmentDist <= bestSegmentDist then
783 begin
784 bestSegmentDist := segmentDist;
785 bestSegmentIndex := i;
786 bestProjection := Points[i]+segmentPos*u;
787 end;
788 end;
789 end;
790 end;
791
792
793 bestPointIndex := -1;
794 bestPointDist := MaxSingle;
795 if not FAddingPoint then
796 for i := 0 to PointCount-1 do
797 if ((i = 0) or isEmptyPointF(Points[i-1])) and
798 ((i = PointCount-1) or isEmptyPointF(Points[i+1])) then
799 begin
800 segmentDist := VectLen(FMousePos-Points[i]);
801 if segmentDist < bestPointDist then
802 begin
803 bestPointDist := segmentDist;
804 bestPointIndex := i;
805 end;
806 end;
807
808 if (bestPointIndex <> -1) and ((bestSegmentIndex = -1) or (bestPointDist < bestSegmentDist)) then
809 begin
810 InsertPoint(bestPointIndex+1, FMousePos);
811 HoverPoint := bestPointIndex+1;
812 end else
813 if bestSegmentIndex <> -1 then
814 begin
815 if ssShift in AShift then
816 InsertPoint(bestSegmentIndex+1, bestProjection)
817 else
818 InsertPoint(bestSegmentIndex+1, FMousePos);
819 HoverPoint:= bestSegmentIndex+1;
820 end;
821 end;
822
TCustomPolypointShape.ComputeStrokenull823 function TCustomPolypointShape.ComputeStroke(APoints: ArrayOfTPointF;
824 AClosed: boolean; AStrokeMatrix: TAffineMatrix): ArrayOfTPointF;
825 begin
826 if Stroker.Arrow = nil then
827 begin
828 Stroker.Arrow := TBGRAArrow.Create;
829 Stroker.ArrowOwned:= true;
830 end;
831 Stroker.Arrow.LineCap:= LineCap;
832 ApplyArrowStyle(Stroker.Arrow, true, ArrowStartKind, ArrowSize);
833 ApplyArrowStyle(Stroker.Arrow, false, ArrowEndKind, ArrowSize);
834 Result:=inherited ComputeStroke(APoints, AClosed, AStrokeMatrix);
835 Stroker.Arrow.StartAsNone;
836 Stroker.Arrow.EndAsNone;
837 end;
838
GetLoopStartIndexnull839 function TCustomPolypointShape.GetLoopStartIndex: integer;
840 var
841 i: Integer;
842 begin
843 for i := PointCount-1 downto 0 do
844 if isEmptyPointF(Points[i]) then exit(i+1);
845 exit(0);
846 end;
847
TCustomPolypointShape.GetLoopPointCountnull848 function TCustomPolypointShape.GetLoopPointCount: integer;
849 begin
850 result := PointCount-GetLoopStartIndex;
851 end;
852
TCustomPolypointShape.GetIsFollowingMousenull853 function TCustomPolypointShape.GetIsFollowingMouse: boolean;
854 begin
855 Result:= Usermode = vsuCreate;
856 end;
857
858 constructor TCustomPolypointShape.Create(AContainer: TVectorOriginal);
859 begin
860 inherited Create(AContainer);
861 FMousePos := EmptyPointF;
862 FClosed:= false;
863 FHoverPoint:= -1;
864 FCenterPoint := EmptyPointF;
865 end;
866
867 procedure TCustomPolypointShape.Clear;
868 begin
869 RemovePointRange(0, PointCount);
870 end;
871
AddPointnull872 function TCustomPolypointShape.AddPoint(const APoint: TPointF): integer;
873 begin
874 result := PointCount;
875 Points[result] := APoint;
876 end;
877
TCustomPolypointShape.RemovePointnull878 function TCustomPolypointShape.RemovePoint(AIndex: integer): boolean;
879 begin
880 if (AIndex < 0) or (AIndex >= PointCount) then exit(false);
881 RemovePointRange(AIndex,AIndex+1);
882 result := true;
883 end;
884
885 procedure TCustomPolypointShape.RemovePointRange(AFromIndex, AToIndexPlus1: integer);
886 var
887 i, delCount: Integer;
888 begin
889 if AFromIndex < 0 then AFromIndex:= 0;
890 if AToIndexPlus1 > PointCount then AToIndexPlus1:= PointCount;
891 if AFromIndex >= AToIndexPlus1 then exit;
892 BeginUpdate(TCustomPolypointShapeDiff);
893 delCount := AToIndexPlus1-AFromIndex;
894 for i := AFromIndex to PointCount-DelCount-1 do
895 FPoints[i] := FPoints[i+delCount];
896 setlength(FPoints, PointCount-delCount);
897 if (HoverPoint >= AFromIndex) and (HoverPoint < AToIndexPlus1) then HoverPoint := -1
898 else if (HoverPoint <> -1) and (HoverPoint >= AToIndexPlus1) then HoverPoint := HoverPoint - delCount;
899 EndUpdate;
900 end;
901
902 procedure TCustomPolypointShape.InsertPoint(AIndex: integer; APoint: TPointF);
903 var
904 i: Integer;
905 begin
906 if (AIndex < 0) or (AIndex > PointCount) then raise exception.Create(rsIndexOutOfBounds);
907 BeginUpdate(TCustomPolypointShapeDiff);
908 setlength(FPoints, PointCount+1);
909 for i := PointCount-1 downto AIndex+1 do
910 FPoints[i] := FPoints[i-1];
911 FPoints[AIndex].coord := APoint;
912 FPoints[AIndex].editorIndex:= -1;
913 FPoints[AIndex].data := 0;
914 if (HoverPoint <> -1) and (HoverPoint >= AIndex) then HoverPoint := HoverPoint + 1;
915 EndUpdate;
916 end;
917
GetPointBoundsnull918 function TCustomPolypointShape.GetPointBounds(AMatrix: TAffineMatrix): TRectF;
919 begin
920 result := GetPointsBoundsF(GetCurve(AMatrix));
921 end;
922
923 procedure TCustomPolypointShape.MouseMove(Shift: TShiftState; X, Y: single; var
924 ACursor: TOriginalEditorCursor; var AHandled: boolean);
925 begin
926 FMousePos := PointF(X,Y);
927 if FAddingPoint then
928 begin
929 BeginUpdate;
930 if (PointCount = 1) and (FMousePos <> Points[PointCount-1]) then
931 Points[PointCount] := FMousePos
932 else
933 Points[PointCount-1] := FMousePos;
934 FillFit;
935 EndUpdate;
936 AHandled:= true;
937 end;
938 end;
939
940 procedure TCustomPolypointShape.MouseDown(RightButton: boolean;
941 Shift: TShiftState; X, Y: single; var ACursor: TOriginalEditorCursor; var
942 AHandled: boolean);
943 begin
944 FMousePos := PointF(X,Y);
945 if FAddingPoint then
946 begin
947 if not RightButton then
948 begin
949 if (PointCount>1) and not PointsEqual(FMousePos,Points[PointCount-2]) then
950 begin
951 BeginUpdate;
952 Points[PointCount-1] := FMousePos;
953 AddPoint(FMousePos);
954 EndUpdate;
955 end;
956 end else
957 Usermode := vsuEdit;
958 AHandled:= true;
959 end else
960 begin
961 if (ssShift in Shift) and (Usermode = vsuEdit) then
962 begin
963 BeginUpdate;
964 AddPoint(EmptyPointF);
965 AddPoint(FMousePos);
966 FillFit;
967 EndUpdate;
968 UserMode := vsuCreate;
969 AHandled:= true;
970 end;
971 end;
972 end;
973
974 procedure TCustomPolypointShape.KeyDown(Shift: TShiftState; Key: TSpecialKey;
975 var AHandled: boolean);
976 var
977 nb, idx: Integer;
978 dx, dy, d: TPointF;
979 begin
980 if (Key = skDelete) and (FAddingPoint or (HoverPoint <> -1)) then
981 begin
982 if (HoverPoint <> -1) then
983 begin
984 BeginUpdate(TCustomPolypointShapeDiff);
985 idx := HoverPoint;
986 RemovePoint(idx);
987 if ((idx = PointCount) or IsEmptyPointF(Points[idx])) and
988 ((idx = 0) or IsEmptyPointF(Points[idx-1])) then
989 begin
990 if idx < PointCount then
991 RemovePoint(idx)
992 else if idx > 0 then
993 RemovePoint(idx-1);
994 end;
995 EndUpdate;
996 if PointCount = 0 then self.Remove;
997 end;
998 AHandled:= true;
999 end else
1000 if (Key = skBackspace) and FAddingPoint then
1001 begin
1002 nb := GetLoopPointCount;
1003 if nb > 2 then
1004 RemovePoint(PointCount-2)
1005 else
1006 begin
1007 if GetLoopStartIndex = 0 then self.Remove
1008 else
1009 begin
1010 RemovePointRange(PointCount-3, PointCount);
1011 Usermode:= vsuEdit;
1012 end;
1013 end;
1014 AHandled:= true;
1015 end else
1016 if (Key = skInsert) then
1017 begin
1018 InsertPointAuto(Shift);
1019 AHandled := true;
1020 end else
1021 if (Key in [skLeft,skUp,skRight,skDown]) and ((HoverPoint <> -1) or HoverCenter) then
1022 begin
1023 if ssCtrl in Shift then
1024 begin
1025 dx := PointF(FGridMatrix[1,1], FGridMatrix[2,1]);
1026 dy := PointF(FGridMatrix[1,2], FGridMatrix[2,2]);
1027 end else
1028 begin
1029 dx := PointF(FViewMatrixInverse[1,1], FViewMatrixInverse[2,1]);
1030 dy := PointF(FViewMatrixInverse[1,2], FViewMatrixInverse[2,2]);
1031 end;
1032 case Key of
1033 skLeft: d := -dx;
1034 skRight: d := dx;
1035 skUp: d := -dy;
1036 skDown: d := dy;
1037 end;
1038 if HoverCenter then
1039 Center := Center + d
1040 else
1041 Points[HoverPoint] := Points[HoverPoint] + d;
1042 AHandled := true;
1043 end else
1044 inherited KeyDown(Shift, Key, AHandled);
1045 end;
1046
1047 procedure TCustomPolypointShape.QuickDefine(constref APoint1, APoint2: TPointF);
1048 begin
1049 BeginUpdate(TCustomPolypointShapeDiff);
1050 FPoints := nil;
1051 AddPoint(APoint1);
1052 if not PointsEqual(APoint1,APoint2) then
1053 AddPoint(APoint2);
1054 EndUpdate;
1055 FMousePos := APoint2;
1056 end;
1057
1058 procedure TCustomPolypointShape.LoadFromStorage(AStorage: TBGRACustomOriginalStorage);
1059 var
1060 x,y: Array of Single;
1061 i: Integer;
1062 begin
1063 BeginUpdate;
1064 inherited LoadFromStorage(AStorage);
1065 Clear;
1066 x := AStorage.FloatArray['x'];
1067 y := AStorage.FloatArray['y'];
1068 setlength(FPoints, max(length(x),length(y)));
1069 for i := 0 to high(FPoints) do
1070 begin
1071 FPoints[i].coord := PointF(x[i],y[i]);
1072 FPoints[i].editorIndex := -1;
1073 FPoints[i].data := 0;
1074 end;
1075 FClosed:= AStorage.Bool['closed'];
1076 if AStorage.HasAttribute('arrow-size') then
1077 FArrowSize := AStorage.PointF['arrow-size']
1078 else FArrowSize := DefaultArrowSize;
1079 FArrowStartKind:= StrToArrowKind(AStorage.RawString['arrow-start-kind']);
1080 FArrowEndKind:= StrToArrowKind(AStorage.RawString['arrow-end-kind']);
1081 Stroker.LineCap := StrToLineCap(AStorage.RawString['line-cap']);
1082 EndUpdate;
1083 end;
1084
1085 procedure TCustomPolypointShape.SaveToStorage(AStorage: TBGRACustomOriginalStorage);
1086 var
1087 x,y: Array of Single;
1088 i: Integer;
1089 begin
1090 inherited SaveToStorage(AStorage);
1091 setlength(x, PointCount);
1092 setlength(y, PointCount);
1093 for i:= 0 to PointCount-1 do
1094 begin
1095 x[i] := Points[i].x;
1096 y[i] := Points[i].y;
1097 end;
1098 AStorage.FloatArray['x'] := x;
1099 AStorage.FloatArray['y'] := y;
1100 AStorage.Bool['closed'] := Closed;
1101 if ArrowStartKind=akNone then AStorage.RemoveAttribute('arrow-start-kind')
1102 else AStorage.RawString['arrow-start-kind'] := ArrowKindToStr[ArrowStartKind];
1103 if ArrowEndKind=akNone then AStorage.RemoveAttribute('arrow-end-kind')
1104 else AStorage.RawString['arrow-end-kind'] := ArrowKindToStr[ArrowEndKind];
1105 if (ArrowStartKind=akNone) and (ArrowEndKind=akNone) then AStorage.RemoveAttribute('arrow-size')
1106 else AStorage.PointF['arrow-size'] := FArrowSize;
1107 AStorage.RawString['line-cap'] := LineCapToStr[Stroker.LineCap];
1108 end;
1109
1110 procedure TCustomPolypointShape.ConfigureCustomEditor(AEditor: TBGRAOriginalEditor);
1111 var
1112 i, nbTotal: Integer;
1113 begin
1114 FViewMatrix := AEditor.Matrix;
1115 if not IsAffineMatrixInversible(FViewMatrix) then exit;
1116 FViewMatrixInverse := AffineMatrixInverse(FViewMatrix);
1117 FGridMatrix := AEditor.GridMatrix;
1118
1119 AEditor.AddStartMoveHandler(@OnStartMove);
1120 AEditor.AddClickPointHandler(@OnClickPoint);
1121 AEditor.AddHoverPointHandler(@OnHoverPoint);
1122
1123 FCenterPoint := PointF(0,0);
1124 nbTotal := 0;
1125 for i:= 0 to PointCount-1 do
1126 if isEmptyPointF(Points[i]) then
1127 FPoints[i].editorIndex := -1
1128 else if (FAddingPoint and (i = PointCount-1) and (GetLoopPointCount > 1)) then
1129 begin
1130 FPoints[i].editorIndex := -1;
1131 FCenterPoint += Points[i];
1132 inc(nbTotal);
1133 end
1134 else
1135 begin
1136 if CanMovePoints then
1137 FPoints[i].editorIndex := AEditor.AddPoint(Points[i], @OnMovePoint, false)
1138 else
1139 FPoints[i].editorIndex := AEditor.AddFixedPoint(Points[i], false);
1140 FCenterPoint += Points[i];
1141 if i = HoverPoint then
1142 AEditor.PointHighlighted[FPoints[i].editorIndex] := true;
1143 inc(nbTotal);
1144 end;
1145
1146 if nbTotal > 0 then
1147 FCenterPoint *= 1/nbTotal
1148 else FCenterPoint := EmptyPointF;
1149
1150 if (FAddingPoint and (nbTotal > 2)) or (not FAddingPoint and (nbTotal > 1)) then
1151 begin
1152 FCenterPointEditorIndex := AEditor.AddPoint(FCenterPoint, @OnMoveCenterPoint, true);
1153 AEditor.PointHighlighted[FCenterPointEditorIndex] := HoverCenter;
1154 end else
1155 FCenterPointEditorIndex := -1;
1156 end;
1157
1158 procedure TCustomPolypointShape.TransformFrame(const AMatrix: TAffineMatrix);
1159 var
1160 i: Integer;
1161 m: TAffineMatrix;
1162 begin
1163 BeginUpdate(TCustomPolypointShapeDiff);
1164 m := MatrixForPixelCentered(AMatrix);
1165 for i := 0 to PointCount-1 do
1166 FPoints[i].coord := m*FPoints[i].coord;
1167 EndUpdate;
1168 end;
1169
1170 { TPolylineShape }
1171
TPolylineShape.Fieldsnull1172 class function TPolylineShape.Fields: TVectorShapeFields;
1173 begin
1174 Result:= [vsfPenFill, vsfPenWidth, vsfPenStyle, vsfJoinStyle, vsfBackFill];
1175 end;
1176
1177 procedure TPolylineShape.Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix;
1178 ADraft: boolean);
1179 var
1180 pts: array of TPointF;
1181 backScan, penScan: TBGRACustomScanner;
1182 begin
1183 if not GetBackVisible and not GetPenVisible then exit;
1184 pts := GetCurve(AMatrix);
1185 if GetBackVisible then
1186 begin
1187 if BackFill.FillType = vftSolid then backScan := nil
1188 else backScan := BackFill.CreateScanner(AMatrix, ADraft);
1189
1190 if ADraft then
1191 begin
1192 if Assigned(backScan) then
1193 ADest.FillPoly(pts, backScan, dmDrawWithTransparency) else
1194 ADest.FillPoly(pts, BackFill.SolidColor, dmDrawWithTransparency);
1195 end
1196 else
1197 begin
1198 if Assigned(backScan) then
1199 ADest.FillPolyAntialias(pts, backScan) else
1200 ADest.FillPolyAntialias(pts, BackFill.SolidColor);
1201 end;
1202
1203 backScan.Free;
1204 end;
1205 if GetPenVisible then
1206 begin
1207 if PenFill.FillType = vftSolid then penScan := nil
1208 else penScan := PenFill.CreateScanner(AMatrix, ADraft);
1209
1210 pts := ComputeStroke(pts, Closed, AMatrix);
1211 if ADraft and (PenWidth > 4) then
1212 begin
1213 if Assigned(penScan) then
1214 ADest.FillPoly(pts, penScan, dmDrawWithTransparency) else
1215 ADest.FillPoly(pts, PenColor, dmDrawWithTransparency);
1216 end
1217 else
1218 begin
1219 if Assigned(penScan) then
1220 ADest.FillPolyAntialias(pts, penScan) else
1221 ADest.FillPolyAntialias(pts, PenColor);
1222 end;
1223
1224 penScan.Free;
1225 end;
1226 end;
1227
AppendToSVGnull1228 function TPolylineShape.AppendToSVG(AContent: TSVGContent; ADefs: TSVGDefine): TSVGElement;
1229 var
1230 p: TBGRAPath;
1231 begin
1232 p := GetPath(AffineMatrixIdentity);
1233 result := AContent.AppendPath(p.SvgString);
1234 p.Free;
1235 ApplyStrokeStyleToSVG(result, ADefs);
1236 if PenVisible then
1237 result.strokeLineCapLCL := LineCap;
1238 ApplyFillStyleToSVG(result, ADefs);
1239 end;
1240
GetRenderBoundsnull1241 function TPolylineShape.GetRenderBounds(ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions): TRectF;
1242 var
1243 pts: ArrayOfTPointF;
1244 xMargin, yMargin: single;
1245 fillBounds, penBounds: TRectF;
1246 begin
1247 if not (GetBackVisible or (rboAssumeBackFill in AOptions)) and not GetPenVisible(rboAssumePenFill in AOptions) then
1248 result:= EmptyRectF
1249 else
1250 begin
1251 pts := GetCurve(AMatrix);
1252 if GetPenVisible(rboAssumePenFill in AOptions) then
1253 begin
1254 if (JoinStyle = pjsRound) and (ArrowStartKind = akNone) and (ArrowEndKind = akNone) then
1255 begin
1256 xMargin := (abs(AMatrix[1,1])+abs(AMatrix[1,2]))*PenWidth*0.5;
1257 yMargin := (abs(AMatrix[2,1])+abs(AMatrix[2,2]))*PenWidth*0.5;
1258 if LineCap = pecSquare then
1259 begin
1260 xMargin *= sqrt(2);
1261 yMargin *= sqrt(2);
1262 end;
1263 result := GetPointsBoundsF(pts);
1264 result.Left -= xMargin;
1265 result.Top -= yMargin;
1266 result.Right += xMargin;
1267 result.Bottom += yMargin;
1268 end else
1269 begin
1270 if GetBackVisible or (rboAssumeBackFill in AOptions) then fillBounds := GetPointsBoundsF(pts)
1271 else fillBounds := EmptyRectF;
1272 pts := ComputeStroke(pts, Closed, AMatrix);
1273 penBounds := GetPointsBoundsF(pts);
1274 result := fillBounds.Union(penBounds, true);
1275 end;
1276 end
1277 else
1278 result := GetPointsBoundsF(pts);
1279 end;
1280 result.Offset(0.5,0.5);
1281 end;
1282
PointInShapenull1283 function TPolylineShape.PointInShape(APoint: TPointF): boolean;
1284 var
1285 pts: ArrayOfTPointF;
1286 begin
1287 if not GetBackVisible and not GetPenVisible then exit(false);
1288 pts := GetCurve(AffineMatrixIdentity);
1289 if GetBackVisible and IsPointInPolygon(pts, APoint, true) then exit(true);
1290 if GetPenVisible then
1291 begin
1292 pts := ComputeStroke(pts, Closed, AffineMatrixIdentity);
1293 if IsPointInPolygon(pts, APoint, true) then exit(true);
1294 end;
1295 result := false;
1296 end;
1297
PointInShapenull1298 function TPolylineShape.PointInShape(APoint: TPointF; ARadius: single): boolean;
1299 var
1300 pts: ArrayOfTPointF;
1301 begin
1302 if not GetBackVisible and not GetPenVisible then exit(false);
1303 pts := GetCurve(AffineMatrixIdentity);
1304 pts := ComputeStrokeEnvelope(pts, Closed, ARadius*2);
1305 result := IsPointInPolygon(pts, APoint, true);
1306 end;
1307
PointInBacknull1308 function TPolylineShape.PointInBack(APoint: TPointF): boolean;
1309 var
1310 pts: ArrayOfTPointF;
1311 scan: TBGRACustomScanner;
1312 begin
1313 if GetBackVisible then
1314 begin
1315 pts := GetCurve(AffineMatrixIdentity);
1316 result := IsPointInPolygon(pts, APoint, true);
1317 if result and (BackFill.FillType = vftTexture) then
1318 begin
1319 scan := BackFill.CreateScanner(AffineMatrixIdentity, false);
1320 if scan.ScanAt(APoint.X,APoint.Y).alpha = 0 then result := false;
1321 scan.Free;
1322 end;
1323 end else
1324 result := false;
1325 end;
1326
TPolylineShape.PointInPennull1327 function TPolylineShape.PointInPen(APoint: TPointF): boolean;
1328 var
1329 pts: ArrayOfTPointF;
1330 begin
1331 if GetBackVisible then
1332 begin
1333 pts := GetCurve(AffineMatrixIdentity);
1334 pts := ComputeStroke(pts, Closed, AffineMatrixIdentity);
1335 result := IsPointInPolygon(pts, APoint, true);
1336 end else
1337 result := false;
1338 end;
1339
GetIsSlownull1340 function TPolylineShape.GetIsSlow(const AMatrix: TAffineMatrix): boolean;
1341 var pts: ArrayOfTPointF;
1342 i: Integer;
1343 ptsBounds: TRectF;
1344 backSurface: Single;
1345 penLength, zoomFactor, penSurface, totalSurface: single;
1346 begin
1347 if not GetPenVisible and not GetBackVisible or (PointCount = 0) then exit(false);
1348
1349 setlength(pts, PointCount);
1350 for i := 0 to high(pts) do
1351 pts[i] := AMatrix * Points[i];
1352
1353 if GetPenVisible then
1354 begin
1355 penLength := 0;
1356 zoomFactor := max(VectLen(AMatrix[1,1],AMatrix[2,1]), VectLen(AMatrix[1,2],AMatrix[2,2]));
1357 for i := 0 to high(pts) do
1358 if (i > 0) then
1359 begin
1360 if pts[i-1].IsEmpty then
1361 begin
1362 if not pts[i].IsEmpty and (LineCap <> pecFlat) then penLength += penWidth/2*zoomFactor;
1363 end else
1364 if pts[i].IsEmpty then
1365 begin
1366 if not pts[i-1].IsEmpty and (LineCap <> pecFlat) then penLength += penWidth/2*zoomFactor;
1367 end else
1368 penLength += VectLen(pts[i]-pts[i-1]);
1369 end;
1370 penSurface := penLength*PenWidth*zoomFactor;
1371 end else penSurface := 0;
1372
1373 if GetBackVisible then
1374 begin
1375 ptsBounds := GetPointsBoundsF(pts);
1376 backSurface := ptsBounds.Width*ptsBounds.Height;
1377 end else
1378 backSurface := 0;
1379
1380 if GetPenVisible and GetBackVisible then totalSurface := backSurface+penSurface/2
1381 else totalSurface := backSurface+penSurface;
1382
1383 Result:= (PointCount > 40) or
1384 ((penSurface > 320*240) and PenFill.IsSlow(AMatrix)) or
1385 ((backSurface > 320*240) and BackFill.IsSlow(AMatrix)) or
1386 (totalSurface > 640*480);
1387 end;
1388
TPolylineShape.StorageClassNamenull1389 class function TPolylineShape.StorageClassName: RawByteString;
1390 begin
1391 result := 'polyline';
1392 end;
1393
1394 { TCurveShape }
1395
1396 procedure TCurveShape.SetSplineStyle(AValue: TSplineStyle);
1397 begin
1398 if FSplineStyle=AValue then Exit;
1399 BeginUpdate(TCurveShapeDiff);
1400 FSplineStyle:=AValue;
1401 EndUpdate;
1402 end;
1403
GetCurveModenull1404 function TCurveShape.GetCurveMode(AIndex: integer): TEasyBezierCurveMode;
1405 begin
1406 if (AIndex < 0) or (AIndex >= PointCount) then exit(cmCurve);
1407 result := TEasyBezierCurveMode(FPoints[AIndex].data);
1408 end;
1409
1410 procedure TCurveShape.SetCosineAngle(AValue: single);
1411 begin
1412 if FCosineAngle=AValue then Exit;
1413 BeginUpdate(TCurveShapeDiff);
1414 FCosineAngle:=AValue;
1415 EndUpdate;
1416 end;
1417
1418 procedure TCurveShape.SetCurveMode(AIndex: integer; AValue: TEasyBezierCurveMode);
1419 begin
1420 if (AIndex < 0) or (AIndex >= PointCount) then exit;
1421 if CurveMode[AIndex] = AValue then exit;
1422 BeginUpdate(TCustomPolypointShapeDiff);
1423 FPoints[AIndex].data := ord(AValue);
1424 EndUpdate
1425 end;
1426
TCurveShape.GetCurvenull1427 function TCurveShape.GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF;
1428 var
1429 pts: array of TPointF;
1430 cm: array of TEasyBezierCurveMode;
1431 i: Integer;
1432 eb: TEasyBezierCurve;
1433 begin
1434 pts := inherited GetCurve(AMatrix);
1435 if FSplineStyle = ssEasyBezier then
1436 begin
1437 setlength(cm, PointCount);
1438 for i := 0 to PointCount-1 do
1439 cm[i] := CurveMode[i];
1440 eb := EasyBezierCurve(pts, Closed, cm, CosineAngle);
1441 result := eb.ToPoints;
1442 end else
1443 begin
1444 if Closed then result := ComputeClosedSpline(pts, FSplineStyle)
1445 else result := ComputeOpenedSpline(pts, FSplineStyle);
1446 end;
1447 end;
1448
TCurveShape.GetPathnull1449 function TCurveShape.GetPath(AMatrix: TAffineMatrix): TBGRAPath;
1450 var
1451 pts: array of TPointF;
1452 cm: array of TEasyBezierCurveMode;
1453 i: Integer;
1454 eb: TEasyBezierCurve;
1455 begin
1456 pts := inherited GetCurve(AMatrix);
1457 result := TBGRAPath.Create;
1458 if FSplineStyle = ssEasyBezier then
1459 begin
1460 setlength(cm, PointCount);
1461 for i := 0 to PointCount-1 do
1462 cm[i] := CurveMode[i];
1463 eb := EasyBezierCurve(pts, Closed, cm, CosineAngle);
1464 eb.CopyToPath(result);
1465 end else
1466 begin
1467 if Closed then result.closedSpline(pts, FSplineStyle)
1468 else result.openedSpline(pts, FSplineStyle);
1469 end;
1470 end;
1471
CanMovePointsnull1472 function TCurveShape.CanMovePoints: boolean;
1473 begin
1474 Result:= Usermode in [vsuCreate,vsuEdit];
1475 end;
1476
1477 procedure TCurveShape.DoClickPoint(APointIndex: integer; AShift: TShiftState);
1478 begin
1479 case Usermode of
1480 vsuCurveSetAuto: CurveMode[APointIndex] := cmAuto;
1481 vsuCurveSetCurve: CurveMode[APointIndex] := cmCurve;
1482 vsuCurveSetAngle: CurveMode[APointIndex] := cmAngle;
1483 else
1484 inherited DoClickPoint(APointIndex, AShift);
1485 end;
1486 end;
1487
TCurveShape.Usermodesnull1488 class function TCurveShape.Usermodes: TVectorShapeUsermodes;
1489 begin
1490 Result:=inherited Usermodes + [vsuCurveSetAuto, vsuCurveSetCurve, vsuCurveSetAngle];
1491 end;
1492
1493 constructor TCurveShape.Create(AContainer: TVectorOriginal);
1494 begin
1495 inherited Create(AContainer);
1496 FSplineStyle:= ssEasyBezier;
1497 end;
1498
1499 constructor TCurveShape.CreateFrom(AContainer: TVectorOriginal;
1500 AShape: TVectorShape);
1501 var
1502 r: TCustomRectShape;
1503 u, v: TPointF;
1504 p: TCustomPolypointShape;
1505 i: Integer;
1506 f: TVectorShapeFields;
1507 sq2m1: single;
1508 begin
1509 Create(AContainer);
1510 if AShape is TEllipseShape then
1511 begin
1512 r := AShape as TCustomRectShape;
1513 u := r.XAxis-r.Origin;
1514 v := r.YAxis-r.Origin;
1515 sq2m1 := sqrt(2)-1;
1516 AddPoint(r.Origin-v+u*sq2m1);
1517 AddPoint(r.Origin-v*sq2m1+u);
1518 AddPoint(r.Origin+v*sq2m1+u);
1519 AddPoint(r.Origin+v+u*sq2m1);
1520 AddPoint(r.Origin+v-u*sq2m1);
1521 AddPoint(r.Origin+v*sq2m1-u);
1522 AddPoint(r.Origin-v*sq2m1-u);
1523 AddPoint(r.Origin-v-u*sq2m1);
1524 Closed := true;
1525 end else
1526 if AShape is TRectShape then
1527 begin
1528 r := AShape as TCustomRectShape;
1529 u := r.XAxis-r.Origin;
1530 v := r.YAxis-r.Origin;
1531 AddPoint(r.Origin-v-u, cmAngle);
1532 AddPoint(r.Origin-v+u, cmAngle);
1533 AddPoint(r.Origin+v+u, cmAngle);
1534 AddPoint(r.Origin+v-u, cmAngle);
1535 Closed := true;
1536 end else
1537 if (AShape is TPolylineShape) and not
1538 (AShape is TCurveShape) then
1539 begin
1540 p := AShape as TCustomPolypointShape;
1541 for i := 0 to p.PointCount-1 do
1542 AddPoint(p.Points[i], cmAngle);
1543 Closed := p.Closed;
1544 end else
1545 raise exception.Create(errShapeNotHandled);
1546
1547 f := AShape.Fields;
1548 if vsfPenFill in f then PenFill.Assign(AShape.PenFill);
1549 if vsfPenWidth in f then PenWidth := AShape.PenWidth;
1550 if vsfPenStyle in f then PenStyle := AShape.PenStyle;
1551 if vsfJoinStyle in f then JoinStyle := AShape.JoinStyle;
1552 if vsfBackFill in f then BackFill.Assign(AShape.BackFill);
1553 end;
1554
TCurveShape.CanCreateFromnull1555 class function TCurveShape.CanCreateFrom(AShape: TVectorShape): boolean;
1556 begin
1557 result := (AShape is TEllipseShape) or
1558 (AShape is TRectShape) or
1559 ((AShape is TPolylineShape) and not
1560 (AShape is TCurveShape));
1561 end;
1562
AddPointnull1563 function TCurveShape.AddPoint(const APoint: TPointF): integer;
1564 begin
1565 if (PointCount > 1) and (APoint = Points[PointCount-1]) then
1566 begin
1567 BeginUpdate;
1568 CurveMode[PointCount-1] := CurveMode[PointCount-2];
1569 Result:=inherited AddPoint(APoint);
1570 EndUpdate;
1571 end
1572 else Result:=inherited AddPoint(APoint);
1573 end;
1574
AddPointnull1575 function TCurveShape.AddPoint(const APoint: TPointF; AMode: TEasyBezierCurveMode): integer;
1576 begin
1577 result := inherited AddPoint(APoint);
1578 CurveMode[result] := AMode;
1579 end;
1580
1581 procedure TCurveShape.KeyPress(UTF8Key: string; var AHandled: boolean);
1582 var
1583 targetPoint: Integer;
1584 begin
1585 if HoverPoint<>-1 then
1586 targetPoint := HoverPoint
1587 else if FAddingPoint and (PointCount > 1) then
1588 targetPoint := PointCount-2
1589 else
1590 targetPoint := -1;
1591 if (targetPoint >= 0) and (targetPoint < PointCount) then
1592 begin
1593 if (UTF8Key = 'A') or (UTF8Key = 'a') then
1594 begin
1595 CurveMode[targetPoint] := cmAuto;
1596 AHandled := true;
1597 end else
1598 if (UTF8Key = 'S') or (UTF8Key = 's') then
1599 begin
1600 CurveMode[targetPoint] := cmCurve;
1601 AHandled:= true;
1602 end else
1603 if (UTF8Key = 'X') or (UTF8Key = 'x') then
1604 begin
1605 CurveMode[targetPoint] := cmAngle;
1606 AHandled:= true;
1607 end;
1608 end;
1609 if not AHandled then
1610 inherited KeyPress(UTF8Key, AHandled);
1611 end;
1612
1613 procedure TCurveShape.LoadFromStorage(AStorage: TBGRACustomOriginalStorage);
1614 var
1615 i: Integer;
1616 cm: array of Single;
1617 begin
1618 BeginUpdate;
1619 inherited LoadFromStorage(AStorage);
1620 case AStorage.RawString['spline-style'] of
1621 'inside': SplineStyle := ssInside;
1622 'inside+ends': SplineStyle := ssInsideWithEnds;
1623 'crossing': SplineStyle := ssCrossing;
1624 'crossing+ends': SplineStyle := ssCrossingWithEnds;
1625 'outside': SplineStyle := ssOutside;
1626 'round-outside': SplineStyle := ssRoundOutside;
1627 'vertex-to-side': SplineStyle := ssVertexToSide;
1628 else
1629 {'easy-bezier'} SplineStyle := ssEasyBezier;
1630 end;
1631 if SplineStyle = ssEasyBezier then
1632 begin
1633 cm := AStorage.FloatArray['curve-mode'];
1634 for i := 0 to min(high(cm),PointCount-1) do
1635 case round(cm[i]) of
1636 1: CurveMode[i] := cmCurve;
1637 2: CurveMode[i] := cmAngle;
1638 end;
1639 if length(cm) < PointCount then
1640 for i:= length(cm) to PointCount-1 do
1641 CurveMode[i] := cmCurve;
1642 end;
1643 CosineAngle := AStorage.FloatDef['cosine-angle', EasyBezierDefaultMinimumDotProduct];
1644 EndUpdate;
1645 end;
1646
1647 procedure TCurveShape.SaveToStorage(AStorage: TBGRACustomOriginalStorage);
1648 var s: string;
1649 cm: array of single;
1650 i: Integer;
1651 begin
1652 inherited SaveToStorage(AStorage);
1653 case SplineStyle of
1654 ssInside: s := 'inside';
1655 ssInsideWithEnds: s := 'inside+ends';
1656 ssCrossing: s := 'crossing';
1657 ssCrossingWithEnds: s := 'crossing+ends';
1658 ssOutside: s := 'outside';
1659 ssRoundOutside: s := 'round-outside';
1660 ssVertexToSide: s := 'vertex-to-side';
1661 ssEasyBezier: s := 'easy-bezier';
1662 else s := '';
1663 end;
1664 AStorage.RawString['spline-style'] := s;
1665 if SplineStyle = ssEasyBezier then
1666 begin
1667 setlength(cm, PointCount);
1668 for i := 0 to PointCount-1 do
1669 cm[i] := ord(CurveMode[i]);
1670 AStorage.FloatArray['curve-mode'] := cm;
1671 end;
1672 AStorage.Float['cosine-angle'] := CosineAngle;
1673 end;
1674
TCurveShape.StorageClassNamenull1675 class function TCurveShape.StorageClassName: RawByteString;
1676 begin
1677 Result:= 'curve';
1678 end;
1679
1680 initialization
1681
1682 RegisterVectorShape(TPolylineShape);
1683 RegisterVectorShape(TCurveShape);
1684
1685 end.
1686
1687