1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Authors: Alexander Klenin
8
9 }
10 unit TAChartAxisUtils;
11
12 {$H+}
13 {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
14 interface
15
16 uses
17 Classes, Graphics, Controls,
18 TAChartUtils, TACustomSource, TADrawUtils, TAIntervalSources, TAStyles,
19 TATypes, TATextElements;
20
21 const
22 DEF_TITLE_DISTANCE = 4;
23
24 type
25 TChartAxisBrush = TClearBrush;
26 TChartBasicAxis = class;
27
28 TChartAxisFramePen = class(TChartPen)
29 published
30 property Style default psClear;
31 end;
32
33 {$IFNDEF fpdoc} // Workaround for issue #18549.
34 TCustomChartAxisTitle =
35 specialize TGenericChartMarks<TChartAxisBrush, TChartPen, TChartAxisFramePen>;
36 {$ENDIF}
37
38 { TChartAxisTitle }
39
40 TChartAxisTitle = class(TCustomChartAxisTitle)
41 strict private
42 FCaption: TCaption;
43 FPositionOnMarks: Boolean;
44 FWordwrap: Boolean;
45
GetFontnull46 function GetFont: TFont;
47 procedure SetCaption(AValue: TCaption);
48 procedure SetFont(AValue: TFont);
49 procedure SetPositionOnMarks(AValue: Boolean);
50 procedure SetWordwrap(AValue: Boolean);
51 public
52 constructor Create(AOwner: TCustomChart);
53
54 public
55 procedure Assign(Source: TPersistent); override;
56 published
57 property Caption: TCaption read FCaption write SetCaption;
58 property Distance default DEF_TITLE_DISTANCE;
59 property Frame;
60 property LabelBrush;
61 property PositionOnMarks: Boolean
62 read FPositionOnMarks write SetPositionOnMarks default false;
63 property TextFormat;
64 property Visible default false;
65 property Wordwrap: Boolean read FWordwrap write SetWordwrap default false;
66 end;
67
68 ICoordTransformer = interface
69 ['{6EDA0F9F-ED59-4CA6-BA68-E247EB88AE3D}']
XGraphToImagenull70 function XGraphToImage(AX: Double): Integer;
YGraphToImagenull71 function YGraphToImage(AY: Double): Integer;
72 end;
73
74 TChartAxisAlignment = (calLeft, calTop, calRight, calBottom);
75 TChartAxisMargins = array [TChartAxisAlignment] of Integer;
76 TChartAxisMarkToTextEvent =
77 procedure (var AText: String; AMark: Double) of object;
78 TChartGetAxisMarkTextEvent =
79 procedure (Sender: TObject; var AText: String; AMark: Double) of object;
80
81 {$IFNDEF fpdoc} // Workaround for issue #18549.
82 TBasicChartAxisMarks =
83 specialize TGenericChartMarks<TChartAxisBrush, TChartPen, TChartAxisFramePen>;
84 {$ENDIF}
85
86 TCustomChartAxisMarks = class(TBasicChartAxisMarks)
87 strict private
88 FDefaultListener: TListener;
89 FDefaultSource: TIntervalChartSource;
90 FSourceExchangeXY: Boolean;
91 FStripes: TChartStyles;
92 procedure SetStripes(AValue: TChartStyles);
93 strict protected
IsFormatStorednull94 function IsFormatStored: Boolean;
95 public
96 constructor Create(AOwner: TCustomChart);
97 destructor Destroy; override;
Measurenull98 function Measure(
99 ADrawer: IChartDrawer; AIsVertical: Boolean; ATickLength: Integer;
100 AValues: TChartValueTextArray): Integer;
101 property DefaultSource: TIntervalChartSource read FDefaultSource;
102 property SourceExchangeXY: Boolean
103 read FSourceExchangeXY write FSourceExchangeXY default false;
104 property Stripes: TChartStyles read FStripes write SetStripes;
105 end;
106
107 TChartMinorAxisMarks = class(TCustomChartAxisMarks)
108 public
109 constructor Create(AOwner: TCustomChart);
110 published
111 property Distance default 1;
112 property Format;
113 property Frame;
114 property LabelBrush;
115 property OverlapPolicy;
116 property Style default smsNone;
117 end;
118
119 { TChartAxisMarks }
120
121 TChartAxisMarks = class(TCustomChartAxisMarks)
122 strict private
123 FAtDataOnly: Boolean;
124 FListener: TListener;
125 FRange: TChartRange;
126 FSource: TCustomChartSource;
127
128 procedure SetAtDataOnly(AValue: Boolean);
129 procedure SetRange(AValue: TChartRange);
130 procedure SetSource(AValue: TCustomChartSource);
131 public
132 constructor Create(AOwner: TCustomChart);
133 destructor Destroy; override;
134
SourceDefnull135 function SourceDef: TCustomChartSource;
136 published
137 property AtDataOnly: Boolean
138 read FAtDataOnly write SetAtDataOnly default false;
139 property Distance default 1;
140 property Format stored IsFormatStored;
141 property Frame;
142 property LabelBrush;
143 property OverlapPolicy;
144 property Range: TChartRange read FRange write SetRange;
145 property RotationCenter;
146 property Source: TCustomChartSource read FSource write SetSource;
147 property SourceExchangeXY;
148 property Stripes;
149 property Style default smsValue;
150 property TextFormat;
151 property YIndex;
152 end;
153
154 TChartAxisGridPen = class(TChartPen)
155 published
156 property Style default psDot;
157 end;
158
159 TChartBasicAxis = class(TCollectionItem)
160 strict private
161 FArrow: TChartArrow;
162 FGrid: TChartAxisGridPen;
163 FTickColor: TColor;
164 FTickInnerLength: Integer;
165 FTickLength: Integer;
166 FVisible: Boolean;
GetIntervalsnull167 function GetIntervals: TChartAxisIntervalParams;
168 procedure SetArrow(AValue: TChartArrow);
169 procedure SetGrid(AValue: TChartAxisGridPen);
170 procedure SetIntervals(AValue: TChartAxisIntervalParams);
171 procedure SetTickColor(AValue: TColor);
172 procedure SetTickInnerLength(AValue: Integer);
173 procedure SetTickLength(AValue: Integer);
174 procedure SetVisible(AValue: Boolean);
175 strict protected
176 FMarks: TCustomChartAxisMarks;
GetAlignmentnull177 function GetAlignment: TChartAxisAlignment; virtual; abstract;
178 procedure SetAlignment(AValue: TChartAxisAlignment); virtual; abstract;
179 procedure SetMarks(AValue: TCustomChartAxisMarks);
180 procedure StyleChanged(ASender: TObject); virtual; abstract;
181 public
182 constructor Create(ACollection: TCollection; AChart: TCustomChart); overload;
183 destructor Destroy; override;
184 public
185 procedure Assign(ASource: TPersistent); override;
IsFlippednull186 function IsFlipped: Boolean; virtual;
TryApplyStripesnull187 function TryApplyStripes(
188 ADrawer: IChartDrawer; var AIndex: Cardinal): Boolean;
189
190 property Alignment: TChartAxisAlignment
191 read GetAlignment write SetAlignment;
192 property Arrow: TChartArrow read FArrow write SetArrow;
193 property Marks: TCustomChartAxisMarks read FMarks write SetMarks;
194 published
195 property Grid: TChartAxisGridPen read FGrid write SetGrid;
196 property Intervals: TChartAxisIntervalParams
197 read GetIntervals write SetIntervals;
198 property TickColor: TColor read FTickColor write SetTickColor default clDefault;
199 property TickInnerLength: Integer
200 read FTickInnerLength write SetTickInnerLength default 0;
201 property TickLength: Integer read FTickLength write SetTickLength;
202 property Visible: Boolean read FVisible write SetVisible default true;
203 end;
204
205 { TAxisDrawHelper }
206
207 TAxisDrawHelper = class
208 strict private
209 FPrevLabelPoly: TPointArray;
210 strict protected
211 procedure BarZ(AX1, AY1, AX2, AY2: Integer); inline;
212 procedure DrawLabel(ALabelCenter: TPoint; const AText: String); inline;
213 procedure DrawLabelAndTick(
214 ACoord, AFixedCoord: Integer; const AText: String); virtual; abstract;
215 procedure GridLine(ACoord: Integer); virtual; abstract;
216 procedure InternalAxisLine(
217 APen: TChartPen; const AStart, AEnd: TPoint; AAngle: Double);
IsInClipRangenull218 function IsInClipRange(ACoord: Integer): Boolean;
219 procedure LineZ(AP1, AP2: TPoint); inline;
TryApplyStripesnull220 function TryApplyStripes: Boolean; inline;
221 public
222 FAtDataOnly: Boolean;
223 FAxis: TChartBasicAxis;
224 FAxisTransf: TTransformFunc;
225 FClipRangeDelta: Integer;
226 FClipRect: ^TRect;
227 FDrawer: IChartDrawer;
228 FPrevCoord: Integer;
229 FScaledTickInnerLength: Integer;
230 FScaledTickLength: Integer;
231 FStripeIndex: Cardinal;
232 FTransf: ICoordTransformer;
233 FValueMax: Double;
234 FValueMin: Double;
235 FMaxForMarks: Double;
236 FMinForMarks: Double;
237 FRotationCenter: TChartTextRotationCenter;
238 FZOffset: TPoint;
239
240 procedure BeginDrawing; virtual;
Clonenull241 function Clone: TAxisDrawHelper;
242 constructor Create; virtual;
243 procedure DrawAxisLine(
244 APen: TChartPen; AFixedCoord: Integer); virtual; abstract;
245 procedure DrawMark(
246 AFixedCoord: Integer; AMark: Double; const AText: String);
247 procedure EndDrawing; virtual; abstract;
248 procedure GetClipRange(out AMin, AMax: Integer); virtual; abstract;
GetDefaultPenColornull249 function GetDefaultPenColor: TColor;
GraphToImagenull250 function GraphToImage(AGraph: Double): Integer; virtual; abstract;
251 end;
252
253 TAxisDrawHelperClass = class of TAxisDrawHelper;
254
255 { TAxisDrawHelperX }
256
257 TAxisDrawHelperX = class(TAxisDrawHelper)
258 strict protected
259 procedure DrawLabelAndTick(
260 ACoord, AFixedCoord: Integer; const AText: String); override;
261 procedure GridLine(ACoord: Integer); override;
262 public
263 procedure BeginDrawing; override;
264 procedure DrawAxisLine(APen: TChartPen; AFixedCoord: Integer); override;
265 procedure EndDrawing; override;
266 procedure GetClipRange(out AMin, AMax: Integer); override;
GraphToImagenull267 function GraphToImage(AGraph: Double): Integer; override;
268 end;
269
270 { TAxisDrawHelperY }
271
272 TAxisDrawHelperY = class(TAxisDrawHelper)
273 strict protected
274 procedure DrawLabelAndTick(
275 ACoord, AFixedCoord: Integer; const AText: String); override;
276 procedure GridLine(ACoord: Integer); override;
277 public
278 procedure BeginDrawing; override;
279 procedure DrawAxisLine(APen: TChartPen; AFixedCoord: Integer); override;
280 procedure EndDrawing; override;
281 procedure GetClipRange(out AMin, AMax: Integer); override;
GraphToImagenull282 function GraphToImage(AGraph: Double): Integer; override;
283 end;
284
285 procedure Register;
286
287 implementation
288
289 uses
290 Math, SysUtils, LResources, PropEdits,
291 TAGeometry, TAMath;
292
293 { TChartMinorAxisMarks }
294
295 constructor TChartMinorAxisMarks.Create(AOwner: TCustomChart);
296 begin
297 inherited Create(AOwner);
298 FStyle := smsNone;
299 FFormat := SERIES_MARK_FORMATS[FStyle];
300 end;
301
302 { TAxisDrawHelper }
303
304 procedure TAxisDrawHelper.BarZ(AX1, AY1, AX2, AY2: Integer);
305 begin
306 with FZOffset do
307 FDrawer.FillRect(AX1 + X, AY1 + Y, AX2 + X, AY2 + Y);
308 end;
309
310 procedure TAxisDrawHelper.BeginDrawing;
311 begin
312 FScaledTickInnerLength := FDrawer.Scale(FAxis.TickInnerLength);
313 FScaledTickLength := FDrawer.Scale(FAxis.TickLength);
314 end;
315
TAxisDrawHelper.Clonenull316 function TAxisDrawHelper.Clone: TAxisDrawHelper;
317 begin
318 Result := TAxisDrawHelperClass(ClassType).Create;
319 Result.FAxis := FAxis;
320 Result.FAxisTransf := FAxisTransf;
321 Result.FClipRect := FClipRect;
322 Result.FDrawer := FDrawer;
323 Result.FTransf := FTransf;
324 Result.FValueMax := FValueMax;
325 Result.FValueMin := FValueMin;
326 Result.FMinForMarks := FMinForMarks;
327 Result.FMaxForMarks := FMaxForMarks;
328 Result.FRotationCenter := FRotationCenter;
329 Result.FZOffset := FZOffset;
330 end;
331
332 constructor TAxisDrawHelper.Create;
333 begin
334 inherited; // Empty -- just to enforce a virtual constructor.
335 end;
336
337 procedure TAxisDrawHelper.DrawLabel(ALabelCenter: TPoint; const AText: String);
338 begin
339 ALabelCenter += FZOffset;
340 FAxis.Marks.DrawLabel(FDrawer, ALabelCenter, ALabelCenter, AText, FPrevLabelPoly);
341 end;
342
343 procedure TAxisDrawHelper.DrawMark(
344 AFixedCoord: Integer; AMark: Double; const AText: String);
345 var
346 coord: Integer;
347 begin
348 coord := GraphToImage(AMark);
349 if
350 not IsInClipRange(coord) or
351 ((FValueMax >= FValueMin) and not InRangeUlps(AMark, FValueMin, FValueMax, 2)) or
352 ((FValueMax < FValueMin) and not InRangeUlps(AMark, FValueMax, FValueMin, 2)) or
353 (not inRangeUlps(AMark, FMinForMarks, FMaxForMarks, 2))
354 then exit;
355
356 if FAxis.Grid.Visible then begin
357 FDrawer.Pen := FAxis.Grid;
358 if (FAxis.Grid.Color = clDefault) then
359 FDrawer.SetPenColor(GetDefaultPenColor);
360 FDrawer.SetBrushParams(bsClear, clTAColor);
361 GridLine(coord);
362 FPrevCoord := coord;
363 end;
364
365 if FAxis.Marks.Visible then begin
366 if (FAxis.TickColor = clDefault) then
367 FDrawer.PrepareSimplePen(GetDefaultPenColor)
368 else
369 FDrawer.PrepareSimplePen(FAxis.TickColor);
370 DrawLabelAndTick(coord, AFixedCoord, AText);
371 end;
372 end;
373
GetDefaultPenColornull374 function TAxisDrawHelper.GetDefaultPenColor: TColor;
375 begin
376 Result := clWindowText;
377 // Not like this: (crashes)
378 // TCustomChart(FAxis.Collection.Owner).GetDefaultColor(dctFont);
379 end;
380
381 procedure TAxisDrawHelper.InternalAxisLine(
382 APen: TChartPen; const AStart, AEnd: TPoint; AAngle: Double);
383 var
384 arrowBase: TPoint;
385 arrowFlipped: boolean;
386 begin
387 if not APen.Visible and not FAxis.Arrow.Visible then exit;
388 FDrawer.Pen := APen;
389 if (APen.Color = clDefault) then
390 FDrawer.SetPenColor(GetDefaultPenColor);
391 if APen.Visible then
392 LineZ(AStart, AEnd);
393 if FAxis.Arrow.Visible then begin
394 arrowFlipped := FAxis.IsFlipped;
395 if arrowFlipped <> FAxis.Arrow.Inverted then arrowFlipped := not arrowFlipped;
396 if FAxis.IsFlipped then begin
397 arrowBase := AStart - FZOffset;
398 if not arrowFlipped then
399 arrowBase -= RotatePointX(-FDrawer.Scale(FAxis.Arrow.Length), AAngle);
400 end else begin
401 arrowBase := AEnd + FZOffset;
402 if arrowFlipped then
403 arrowBase += RotatePointX(-FDrawer.Scale(FAxis.Arrow.Length), AAngle);
404 end;
405 FAxis.Arrow.Draw(FDrawer, arrowBase, AAngle, APen)
406 end;
407 end;
408
TAxisDrawHelper.IsInClipRangenull409 function TAxisDrawHelper.IsInClipRange(ACoord: Integer): Boolean;
410 var
411 rmin, rmax: Integer;
412 begin
413 GetClipRange(rmin, rmax);
414 Result := InRange(ACoord, rmin + FClipRangeDelta, rmax - FClipRangeDelta);
415 end;
416
417 procedure TAxisDrawHelper.LineZ(AP1, AP2: TPoint);
418 begin
419 FDrawer.Line(AP1 + FZOffset, AP2 + FZOffset);
420 end;
421
TryApplyStripesnull422 function TAxisDrawHelper.TryApplyStripes: Boolean;
423 begin
424 Result := FAxis.TryApplyStripes(FDrawer, FStripeIndex);
425 end;
426
427 { TAxisDrawHelperX }
428
429 procedure TAxisDrawHelperX.BeginDrawing;
430 begin
431 inherited;
432 FPrevCoord := FClipRect^.Left;
433 end;
434
435 procedure TAxisDrawHelperX.DrawAxisLine(APen: TChartPen; AFixedCoord: Integer);
436 var
437 p1, p2: TPoint;
438 begin
439 if FAxis.IsFlipped then begin
440 p1 := Point(Math.IfThen(FAtDataOnly, GraphToImage(FMaxForMarks), FClipRect^.Left), AFixedCoord);
441 p2 := Point(Math.IfThen(FAtDataOnly, GraphToImage(FMinForMarks), FClipRect^.Right), AFixedCoord);
442 if FAxis.Arrow.Visible then
443 p1.X -= FDrawer.Scale(FAxis.Arrow.Length);
444 end else begin
445 p1 := Point(Math.IfThen(FAtDataOnly, GraphToImage(FMinForMarks), FClipRect^.Left), AFixedCoord);
446 p2 := Point(Math.IfThen(FAtDataOnly, GraphToImage(FMaxForMarks), FClipRect^.Right), AFixedCoord);
447 if FAxis.Arrow.Visible then
448 p2.X += FDrawer.Scale(FAxis.Arrow.Length);
449 end;
450 InternalAxisLine(APen, p1, p2, 0);
451 end;
452
453 procedure TAxisDrawHelperX.DrawLabelAndTick(
454 ACoord, AFixedCoord: Integer; const AText: String);
455 var
456 d, up, down: Integer;
457 begin
458 if FRotationCenter = rcCenter then
459 d := FScaledTickLength + FAxis.Marks.CenterOffset(FDrawer, AText).cy
460 else
461 d := FScaledTickLength + FAxis.Marks.CenterHeightOffset(FDrawer, AText).cy;
462 up := FScaledTickInnerLength;
463 down := FScaledTickLength;
464 if FAxis.Alignment = calTop then begin
465 d := -d;
466 Exchange(up, down);
467 end;
468 LineZ(Point(ACoord, AFixedCoord - up), Point(ACoord, AFixedCoord + down));
469 DrawLabel(Point(ACoord, AFixedCoord + d), AText);
470 end;
471
472 procedure TAxisDrawHelperX.EndDrawing;
473 begin
474 if FAxis.Grid.Visible and TryApplyStripes then
475 BarZ(FPrevCoord + 1, FClipRect^.Top + 1, FClipRect^.Right, FClipRect^.Bottom);
476 end;
477
478 procedure TAxisDrawHelperX.GetClipRange(out AMin, AMax: Integer);
479 begin
480 AMin := FClipRect^.Left;
481 AMax := FClipRect^.Right;
482 end;
483
GraphToImagenull484 function TAxisDrawHelperX.GraphToImage(AGraph: Double): Integer;
485 begin
486 Result := FTransf.XGraphToImage(AGraph);
487 end;
488
489 procedure TAxisDrawHelperX.GridLine(ACoord: Integer);
490 begin
491 if TryApplyStripes then
492 BarZ(FPrevCoord + 1, FClipRect^.Top + 1, ACoord, FClipRect^.Bottom);
493 LineZ(Point(ACoord, FClipRect^.Top), Point(ACoord, FClipRect^.Bottom));
494 end;
495
496 { TAxisDrawHelperY }
497
498 procedure TAxisDrawHelperY.BeginDrawing;
499 begin
500 inherited;
501 FPrevCoord := FClipRect^.Bottom;
502 end;
503
504 procedure TAxisDrawHelperY.DrawAxisLine(APen: TChartPen; AFixedCoord: Integer);
505 var
506 p1, p2: TPoint;
507 begin
508 if FAxis.IsFlipped then begin
509 p1 := Point(AFixedCoord, Math.IfThen(FAtDataOnly, GraphToImage(FMaxForMarks), FClipRect^.Bottom));
510 p2 := Point(AFixedCoord, Math.IfThen(FAtDataOnly, GraphToImage(FMinForMarks), FClipRect^.Top));
511 if FAxis.Arrow.Visible then
512 p1.Y += FDrawer.Scale(FAxis.Arrow.Length);
513 end else begin
514 p1 := Point(AFixedCoord, Math.IfThen(FAtDataOnly, GraphToImage(FMinForMarks), FClipRect^.Bottom));
515 p2 := Point(AFixedCoord, Math.IfThen(FAtDataOnly, GraphToImage(FMaxForMarks), FClipRect^.Top));
516 if FAxis.Arrow.Visible then
517 p2.Y -= FDrawer.Scale(FAxis.Arrow.Length);
518 end;
519 InternalAxisLine(APen, p1, p2, -Pi / 2);
520 end;
521
522 procedure TAxisDrawHelperY.DrawLabelAndTick(
523 ACoord, AFixedCoord: Integer; const AText: String);
524 var
525 d, left, right: Integer;
526 begin
527 if FRotationCenter = rcCenter then
528 d := FScaledTickLength + FAxis.Marks.CenterOffset(FDrawer, AText).cx
529 else
530 d := FScaledTickLength + FAxis.Marks.CenterHeightOffset(FDrawer, AText).cx;
531 left := FScaledTickInnerLength;
532 right := FScaledTickLength;
533 if FAxis.Alignment = calLeft then begin
534 d := -d;
535 Exchange(left, right);
536 end;
537 LineZ(Point(AFixedCoord - left, ACoord), Point(AFixedCoord + right, ACoord));
538 DrawLabel(Point(AFixedCoord + d, ACoord), AText);
539 end;
540
541 procedure TAxisDrawHelperY.EndDrawing;
542 begin
543 if FAxis.Grid.Visible and TryApplyStripes then
544 BarZ(FClipRect^.Left + 1, FClipRect^.Top + 1, FClipRect^.Right, FPrevCoord);
545 end;
546
547 procedure TAxisDrawHelperY.GetClipRange(out AMin, AMax: Integer);
548 begin
549 AMin := FClipRect^.Top;
550 AMax := FClipRect^.Bottom;
551 end;
552
TAxisDrawHelperY.GraphToImagenull553 function TAxisDrawHelperY.GraphToImage(AGraph: Double): Integer;
554 begin
555 Result := FTransf.YGraphToImage(AGraph);
556 end;
557
558 procedure TAxisDrawHelperY.GridLine(ACoord: Integer);
559 begin
560 if TryApplyStripes then
561 BarZ(FClipRect^.Left + 1, FPrevCoord, FClipRect^.Right, ACoord);
562 LineZ(Point(FClipRect^.Left, ACoord), Point(FClipRect^.Right, ACoord));
563 end;
564
565 { TChartAxisTitle }
566
567 procedure TChartAxisTitle.Assign(Source: TPersistent);
568 begin
569 if Source is TChartAxisTitle then
570 with TChartAxisTitle(Source) do begin
571 Self.FLabelBrush.Assign(FLabelBrush);
572 Self.FLabelFont.Assign(FLabelFont);
573 Self.FLinkPen.Assign(FLinkPen);
574 Self.FCaption := FCaption;
575 end;
576 inherited Assign(Source);
577 end;
578
579 constructor TChartAxisTitle.Create(AOwner: TCustomChart);
580 begin
581 inherited Create(AOwner);
582 FDistance := DEF_TITLE_DISTANCE;
583 FLabelBrush.Style := bsClear;
584 FVisible := false;
585 end;
586
TChartAxisTitle.GetFontnull587 function TChartAxisTitle.GetFont: TFont;
588 begin
589 Result := LabelFont;
590 end;
591
592 procedure TChartAxisTitle.SetCaption(AValue: TCaption);
593 begin
594 if FCaption = AValue then exit;
595 FCaption := AValue;
596 StyleChanged(Self);
597 end;
598
599 procedure TChartAxisTitle.SetFont(AValue: TFont);
600 begin
601 LabelFont := AValue;
602 end;
603
604 procedure TChartAxisTitle.SetPositionOnMarks(AValue: Boolean);
605 begin
606 if FPositionOnMarks = AValue then exit;
607 FPositionOnMarks := AValue;
608 StyleChanged(Self);
609 end;
610
611 procedure TChartAxisTitle.SetWordwrap(AValue: Boolean);
612 begin
613 if FWordwrap = AValue then exit;
614 FWordwrap := AValue;
615 StyleChanged(Self);
616 end;
617
618
619 { TCustomChartAxisMarks }
620
621 constructor TCustomChartAxisMarks.Create(AOwner: TCustomChart);
622 begin
623 inherited Create(AOwner);
624 FDefaultListener := TListener.Create(nil, @StyleChanged);
625 FDefaultSource := TIntervalChartSource.Create(AOwner);
626 FDefaultSource.Broadcaster.Subscribe(FDefaultListener);
627 FDistance := 1;
628 FLabelBrush.Style := bsClear;
629 end;
630
631 destructor TCustomChartAxisMarks.Destroy;
632 begin
633 FreeAndNil(FDefaultListener);
634 FreeAndNil(FDefaultSource);
635 inherited;
636 end;
637
TCustomChartAxisMarks.IsFormatStorednull638 function TCustomChartAxisMarks.IsFormatStored: Boolean;
639 begin
640 Result := FStyle <> smsValue;
641 end;
642
Measurenull643 function TCustomChartAxisMarks.Measure(ADrawer: IChartDrawer;
644 AIsVertical: Boolean; ATickLength: Integer;
645 AValues: TChartValueTextArray): Integer;
646 var
647 t: TChartValueText;
648 begin
649 Result := 0;
650 if not Visible then exit;
651 for t in AValues do
652 // Workaround for issue #19780, fix after upgrade to FPC 2.6.
653 with MeasureLabel(ADrawer, t.FText) do
654 Result := Max(Math.IfThen(AIsVertical, cy, cx), Result);
655 if Result = 0 then exit;
656 if DistanceToCenter then
657 Result := Result div 2;
658 Result += ADrawer.Scale(ATickLength) + ADrawer.Scale(Distance);
659 end;
660
661 procedure TCustomChartAxisMarks.SetStripes(AValue: TChartStyles);
662 begin
663 if FStripes = AValue then exit;
664 FStripes := AValue;
665 StyleChanged(Self);
666 end;
667
668 { TChartAxisMarks }
669
670 constructor TChartAxisMarks.Create(AOwner: TCustomChart);
671 begin
672 inherited Create(AOwner);
673 FListener := TListener.Create(@FSource, @StyleChanged);
674 FRange := TChartRange.Create(AOwner);
675 FStyle := smsValue;
676 FFormat := SERIES_MARK_FORMATS[FStyle];
677 end;
678
679 destructor TChartAxisMarks.Destroy;
680 begin
681 FreeAndNil(FRange);
682 FreeAndNil(FListener);
683 inherited;
684 end;
685
686 procedure TChartAxisMarks.SetAtDataOnly(AValue: Boolean);
687 begin
688 if FAtDataOnly = AValue then exit;
689 FAtDataOnly := AValue;
690 StyleChanged(Self);
691 end;
692
693 procedure TChartAxisMarks.SetRange(AValue: TChartRange);
694 begin
695 if FRange = AValue then exit;
696 FRange.Assign(AValue);
697 StyleChanged(Self);
698 end;
699
700 procedure TChartAxisMarks.SetSource(AValue: TCustomChartSource);
701 begin
702 if FSource = AValue then exit;
703 if FListener.IsListening then
704 FSource.Broadcaster.Unsubscribe(FListener);
705 FSource := AValue;
706 if FSource <> nil then
707 FSource.Broadcaster.Subscribe(FListener);
708 StyleChanged(Self);
709 end;
710
TChartAxisMarks.SourceDefnull711 function TChartAxisMarks.SourceDef: TCustomChartSource;
712 begin
713 Result := FSource;
714 if Result = nil then
715 Result := DefaultSource;
716 end;
717
718 { TChartBasicAxis }
719
720 procedure TChartBasicAxis.Assign(ASource: TPersistent);
721 begin
722 if ASource is TChartBasicAxis then
723 with TChartBasicAxis(ASource) do begin
724 Self.FArrow.Assign(Arrow);
725 Self.FGrid.Assign(Grid);
726 Self.FMarks.Assign(Marks);
727 Self.FTickColor := TickColor;
728 Self.FTickLength := TickLength;
729 Self.FTickInnerLength := TickInnerLength;
730 Self.FVisible := Visible;
731 end
732 else
733 inherited Assign(ASource);
734 end;
735
736 constructor TChartBasicAxis.Create(
737 ACollection: TCollection; AChart: TCustomChart);
738 begin
739 inherited Create(ACollection);
740 FArrow := TChartArrow.Create(AChart);
741 FGrid := TChartAxisGridPen.Create;
742 FGrid.OnChange := @StyleChanged;
743 // FMarks must be created in descendants.
744 FTickColor := clDefault;
745 FVisible := true;
746 end;
747
748 destructor TChartBasicAxis.Destroy;
749 begin
750 FreeAndNil(FArrow);
751 FreeAndNil(FGrid);
752 FreeAndNil(FMarks);
753 inherited;
754 end;
755
TChartBasicAxis.GetIntervalsnull756 function TChartBasicAxis.GetIntervals: TChartAxisIntervalParams;
757 begin
758 Result := Marks.DefaultSource.Params;
759 end;
760
TChartBasicAxis.IsFlippednull761 function TChartBasicAxis.IsFlipped: Boolean;
762 begin
763 Result := false;
764 end;
765
766 procedure TChartBasicAxis.SetArrow(AValue: TChartArrow);
767 begin
768 FArrow.Assign(AValue);
769 StyleChanged(Self);
770 end;
771
772 procedure TChartBasicAxis.SetGrid(AValue: TChartAxisGridPen);
773 begin
774 FGrid.Assign(AValue);
775 StyleChanged(Self);
776 end;
777
778 procedure TChartBasicAxis.SetIntervals(AValue: TChartAxisIntervalParams);
779 begin
780 Marks.DefaultSource.Params := AValue;
781 end;
782
783 procedure TChartBasicAxis.SetMarks(AValue: TCustomChartAxisMarks);
784 begin
785 FMarks.Assign(AValue);
786 StyleChanged(Self);
787 end;
788
789 procedure TChartBasicAxis.SetTickColor(AValue: TColor);
790 begin
791 if FTickColor = AValue then exit;
792 FTickColor := AValue;
793 StyleChanged(Self);
794 end;
795
796 procedure TChartBasicAxis.SetTickInnerLength(AValue: Integer);
797 begin
798 if FTickInnerLength = AValue then exit;
799 FTickInnerLength := AValue;
800 StyleChanged(Self);
801 end;
802
803 procedure TChartBasicAxis.SetTickLength(AValue: Integer);
804 begin
805 if FTickLength = AValue then exit;
806 FTickLength := AValue;
807 StyleChanged(Self);
808 end;
809
810 procedure TChartBasicAxis.SetVisible(AValue: Boolean);
811 begin
812 if FVisible = AValue then exit;
813 FVisible := AValue;
814 StyleChanged(Self);
815 end;
816
TChartBasicAxis.TryApplyStripesnull817 function TChartBasicAxis.TryApplyStripes(
818 ADrawer: IChartDrawer; var AIndex: Cardinal): Boolean;
819 begin
820 Result := Marks.Stripes <> nil;
821 if not Result then exit;
822 Marks.Stripes.Apply(ADrawer, AIndex);
823 AIndex += 1;
824 end;
825
826 procedure SkipObsoleteProperties;
827 const
828 FONT_NOTE = 'Obsolete, use ChartTitle.LabelFont instead';
829 begin
830 RegisterPropertyToSkip(TChartAxisTitle, 'Font', FONT_NOTE, '');
831 end;
832
833 procedure Register;
834 begin
835 RegisterPropertyEditor(
836 TypeInfo(TCaption), TChartAxisTitle, '', TStringMultilinePropertyEditor);
837 SkipObsoleteProperties;
838 end;
839
840 end.
841