1 {
2 /***************************************************************************
3 TAGraph.pas
4 -----------
5 Component Library Standard Graph
6
7
8 ***************************************************************************/
9
10 *****************************************************************************
11 See the file COPYING.modifiedLGPL.txt, included in this distribution,
12 for details about the license.
13 *****************************************************************************
14
15 Authors: Luís Rodrigues, Philippe Martinole, Alexander Klenin
16
17 }
18 unit TAGraph;
19
20 {$H+}
21 {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
22
23 interface
24
25 uses
26 Graphics, Classes, Controls, LCLType, SysUtils,
27 TAChartAxis, TAChartAxisUtils, TAChartUtils, TADrawUtils, TAGUIConnector,
28 TALegend, TATextElements, TATypes;
29
30 type
31 TChart = class;
32
33 TChartDrawLegendEvent = procedure(
34 ASender: TChart; ADrawer: IChartDrawer; ALegendItems: TChartLegendItems;
35 ALegendItemSize: TPoint; const ALegendRect: TRect;
36 AColCount, ARowCount: Integer) of object;
37
38 { TBasicChartSeries }
39
40 TBasicChartSeries = class(TIndexedComponent)
41 protected
42 FActive: Boolean;
43 FChart: TChart;
44 FDepth: TChartDistance;
45 FDragOrigin: TPoint;
46 FShadow: TChartShadow;
47 FTransparency: TChartTransparency;
48 FZPosition: TChartDistance;
49 FSpecialPointPos: Boolean;
50
51 procedure AfterAdd; virtual; abstract;
52 procedure AfterDraw; virtual;
53 procedure BeforeDraw; virtual;
54 procedure GetLegendItemsBasic(AItems: TChartLegendItems); virtual; abstract;
GetShowInLegendnull55 function GetShowInLegend: Boolean; virtual; abstract;
RequestValidChartScalingnull56 function RequestValidChartScaling: Boolean; virtual;
57 procedure SetActive(AValue: Boolean); virtual; abstract;
58 procedure SetDepth(AValue: TChartDistance); virtual; abstract;
59 procedure SetShadow(AValue: TChartShadow); virtual; abstract;
60 procedure SetShowInLegend(AValue: Boolean); virtual; abstract;
61 procedure SetTransparency(AValue: TChartTransparency); virtual; abstract;
62 procedure SetZPosition(AValue: TChartDistance); virtual; abstract;
63 procedure UpdateMargins(ADrawer: IChartDrawer; var AMargins: TRect); virtual;
64 procedure VisitSources(
65 AVisitor: TChartOnSourceVisitor; AAxis: TChartAxis; var AData); virtual;
66
67 public
AxisToGraphXnull68 function AxisToGraphX(AX: Double): Double; virtual;
AxisToGraphYnull69 function AxisToGraphY(AY: Double): Double; virtual;
GraphToAxisXnull70 function GraphToAxisX(AX: Double): Double; virtual;
GraphToAxisYnull71 function GraphToAxisY(AY: Double): Double; virtual;
72
73 public
74 procedure Assign(Source: TPersistent); override;
75 destructor Destroy; override;
76
77 public
78 procedure Draw(ADrawer: IChartDrawer); virtual; abstract;
GetAxisBoundsnull79 function GetAxisBounds(AAxis: TChartAxis; out AMin, AMax: Double): boolean; virtual; abstract;
GetGraphBoundsnull80 function GetGraphBounds: TDoubleRect; virtual; abstract;
IsEmptynull81 function IsEmpty: Boolean; virtual; abstract;
82 procedure MovePoint(var AIndex: Integer; const ANewPos: TPoint); overload; inline;
83 procedure MovePoint(var AIndex: Integer; const ANewPos: TDoublePoint); overload; virtual;
84 procedure MovePointEx(var AIndex: Integer; AXIndex, AYIndex: Integer;
85 const ANewPos: TDoublePoint); virtual;
86 procedure UpdateBiDiMode; virtual;
87
88 property Active: Boolean read FActive write SetActive default true;
89 property Depth: TChartDistance read FDepth write SetDepth default 0;
90 property DragOrigin: TPoint read FDragOrigin write FDragOrigin;
91 property ParentChart: TChart read FChart;
92 property Shadow: TChartShadow read FShadow write SetShadow;
93 property SpecialPointPos: Boolean read FSpecialPointPos;
94 property Transparency: TChartTransparency
95 read FTransparency write SetTransparency default 0;
96 property ZPosition: TChartDistance read FZPosition write SetZPosition default 0;
97 end;
98
99 TSeriesClass = class of TBasicChartSeries;
100
101 { TBasicСhartTool }
102
103 TBasicChartTool = class(TIndexedComponent)
104 strict protected
105 FChart: TChart;
106 FStartMousePos: TPoint;
107
108 procedure Activate; virtual;
109 procedure Deactivate; virtual;
PopupMenuConflictnull110 function PopupMenuConflict: Boolean; virtual;
111 public
112 property Chart: TChart read FChart;
113 end;
114
115 TChartToolEventId = (
116 evidKeyDown, evidKeyUp, evidMouseDown, evidMouseMove, evidMouseUp,
117 evidMouseWheelDown, evidMouseWheelUp);
118
119 { TBasicChartToolset }
120
121 TBasicChartToolset = class(TComponent)
122 public
Dispatchnull123 function Dispatch(
124 AChart: TChart; AEventId: TChartToolEventId;
125 AShift: TShiftState; APoint: TPoint): Boolean; virtual; abstract; overload;
126 procedure Draw(AChart: TChart; ADrawer: IChartDrawer); virtual; abstract;
127 end;
128
129 TBasicChartSeriesEnumerator = class(TFPListEnumerator)
130 public
GetCurrentnull131 function GetCurrent: TBasicChartSeries;
132 property Current: TBasicChartSeries read GetCurrent;
133 end;
134
135 { TChartSeriesList }
136
137 TChartSeriesList = class(TPersistent)
138 private
139 FList: TIndexedComponentList;
GetItemnull140 function GetItem(AIndex: Integer): TBasicChartSeries;
141 public
142 constructor Create;
143 destructor Destroy; override;
144 public
145 procedure Clear;
Countnull146 function Count: Integer;
GetEnumeratornull147 function GetEnumerator: TBasicChartSeriesEnumerator;
148 procedure UpdateBiDiMode;
149 public
150 property Items[AIndex: Integer]: TBasicChartSeries read GetItem; default;
151 property List: TIndexedComponentList read FList;
152 end;
153
154 TChartAfterCustomDrawEvent = procedure (
155 ASender: TChart; ADrawer: IChartDrawer; const ARect: TRect) of object;
156 TChartBeforeCustomDrawEvent = procedure (
157 ASender: TChart; ADrawer: IChartDrawer; const ARect: TRect;
158 var ADoDefaultDrawing: Boolean) of object;
159
160 TChartAfterDrawEvent = procedure (
161 ASender: TChart; ACanvas: TCanvas; const ARect: TRect) of object;
162 TChartBeforeDrawEvent = procedure (
163 ASender: TChart; ACanvas: TCanvas; const ARect: TRect;
164 var ADoDefaultDrawing: Boolean) of object;
165 TChartEvent = procedure (ASender: TChart) of object;
166 TChartPaintEvent = procedure (
167 ASender: TChart; const ARect: TRect;
168 var ADoDefaultDrawing: Boolean) of object;
169 TChartDrawEvent = procedure (
170 ASender: TChart; ADrawer: IChartDrawer) of object;
171 TChartExtentValidateEvent = procedure (
172 ASender: TChart; var ALogicalExtent: TDoubleRect; var AllowChange: Boolean) of object;
173
174 TChartRenderingParams = record
175 FClipRect: TRect;
176 FIsZoomed: Boolean;
177 FLogicalExtent, FPrevLogicalExtent: TDoubleRect;
178 FScale, FOffset: TDoublePoint;
179 end;
180
181 { TChart }
182
183 TChart = class(TCustomChart, ICoordTransformer)
184 strict private // Property fields
185 FAllowZoom: Boolean;
186 FAllowPanning: Boolean;
187 FAntialiasingMode: TChartAntialiasingMode;
188 FAxisList: TChartAxisList;
189 FAxisVisible: Boolean;
190 FBackColor: TColor;
191 FConnectorData: TChartGUIConnectorData;
192 FDepth: TChartDistance;
193 FDefaultGUIConnector: TChartGUIConnector;
194 FExpandPercentage: Integer;
195 FExtent: TChartExtent;
196 FExtentSizeLimit: TChartExtent;
197 FFoot: TChartTitle;
198 FFrame: TChartPen;
199 FGUIConnector: TChartGUIConnector;
200 FGUIConnectorListener: TListener;
201 FLegend: TChartLegend;
202 FLogicalExtent: TDoubleRect;
203 FMargins: TChartMargins;
204 FMarginsExternal: TChartMargins;
205 FMinDataSpace: Integer;
206 FOnAfterCustomDrawBackground: TChartAfterCustomDrawEvent;
207 FOnAfterCustomDrawBackWall: TChartAfterCustomDrawEvent;
208 FOnAfterDraw: TChartDrawEvent;
209 FOnAfterDrawBackground: TChartAfterDrawEvent;
210 FOnAfterDrawBackWall: TChartAfterDrawEvent;
211 FOnBeforeCustomDrawBackground: TChartBeforeCustomDrawEvent;
212 FOnBeforeCustomDrawBackWall: TChartBeforeCustomDrawEvent;
213 FOnBeforeDrawBackground: TChartBeforeDrawEvent;
214 FOnBeforeDrawBackWall: TChartBeforeDrawEvent;
215 FOnChartPaint: TChartPaintEvent;
216 FOnDrawLegend: TChartDrawLegendEvent;
217 FProportional: Boolean;
218 FSeries: TChartSeriesList;
219 FSetLogicalExtentCounter: Integer;
220 FTitle: TChartTitle;
221 FToolset: TBasicChartToolset;
222
ClipRectWithoutFramenull223 function ClipRectWithoutFrame(AZPosition: TChartDistance): TRect;
EffectiveGUIConnectornull224 function EffectiveGUIConnector: TChartGUIConnector; inline;
225 private
226 FActiveToolIndex: Integer;
227 FAutoFocus: Boolean;
228 FBroadcaster: TBroadcaster;
229 FClipRectBroadcaster: TBroadcaster;
230 FBuiltinToolset: TBasicChartToolset;
231 FClipRect: TRect;
232 FCurrentExtent: TDoubleRect;
233 FDisableRedrawingCounter: Integer;
234 FExtentBroadcaster: TBroadcaster;
235 FFullExtentBroadcaster: TBroadcaster;
236 FIsZoomed: Boolean;
237 FOffset: TDoublePoint; // Coordinates transformation
238 FOffsetInt: TPoint; // Coordinates transformation
239 FOnAfterPaint: TChartEvent;
240 FOnExtentChanged: TChartEvent;
241 FOnExtentChanging: TChartEvent;
242 FOnExtentValidate: TChartExtentValidateEvent;
243 FOnFullExtentChanged: TChartEvent;
244 FBufferedFullExtent: TDoubleRect;
245 FPrevFullExtent: TDoubleRect;
246 FPrevLogicalExtent: TDoubleRect;
247 FScale: TDoublePoint; // Coordinates transformation
248 FScalingValid: Boolean;
249 FMultiPassScalingNeeded: Boolean;
250 FOldClipRect: TRect;
251 FSavedClipRect: TRect;
252 FClipRectLock: Integer;
253
254 procedure CalculateTransformationCoeffs(const AMargin, AChartMargins: TRect;
255 const AMinDataSpace: Integer);
256 procedure FindComponentClass(
257 AReader: TReader; const AClassName: String; var AClass: TComponentClass);
FullExtentBroadcastActivenull258 function FullExtentBroadcastActive: Boolean;
GetChartHeightnull259 function GetChartHeight: Integer;
GetChartWidthnull260 function GetChartWidth: Integer;
GetHorAxisnull261 function GetHorAxis: TChartAxis;
GetMarginsnull262 function GetMargins(ADrawer: IChartDrawer): TRect;
GetRenderingParamsnull263 function GetRenderingParams: TChartRenderingParams;
GetSeriesCountnull264 function GetSeriesCount: Integer;
GetToolsetnull265 function GetToolset: TBasicChartToolset;
GetVertAxisnull266 function GetVertAxis: TChartAxis;
267 procedure SetAntialiasingMode(AValue: TChartAntialiasingMode);
268 procedure SetAxisList(AValue: TChartAxisList);
269 procedure SetAxisVisible(Value: Boolean);
270 procedure SetBackColor(AValue: TColor);
271 procedure SetDepth(AValue: TChartDistance);
272 procedure SetExpandPercentage(AValue: Integer);
273 procedure SetExtent(AValue: TChartExtent);
274 procedure SetExtentSizeLimit(AValue: TChartExtent);
275 procedure SetFoot(Value: TChartTitle);
276 procedure SetFrame(Value: TChartPen);
277 procedure SetGUIConnector(AValue: TChartGUIConnector);
278 procedure SetLegend(Value: TChartLegend);
279 procedure SetLogicalExtent(AValue: TDoubleRect);
280 procedure SetMargins(AValue: TChartMargins);
281 procedure SetMarginsExternal(AValue: TChartMargins);
282 procedure SetMinDataSpace(const AValue: Integer);
283 procedure SetOnAfterCustomDrawBackground(AValue: TChartAfterCustomDrawEvent);
284 procedure SetOnAfterCustomDrawBackWall(AValue: TChartAfterCustomDrawEvent);
285 procedure SetOnAfterDraw(AValue: TChartDrawEvent);
286 procedure SetOnAfterDrawBackground(AValue: TChartAfterDrawEvent);
287 procedure SetOnAfterDrawBackWall(AValue: TChartAfterDrawEvent);
288 procedure SetOnBeforeCustomDrawBackground(AValue: TChartBeforeCustomDrawEvent);
289 procedure SetOnBeforeCustomDrawBackWall(AValue: TChartBeforeCustomDrawEvent);
290 procedure SetOnBeforeDrawBackground(AValue: TChartBeforeDrawEvent);
291 procedure SetOnBeforeDrawBackWall(AValue: TChartBeforeDrawEvent);
292 procedure SetOnChartPaint(AValue: TChartPaintEvent);
293 procedure SetOnDrawLegend(AValue: TChartDrawLegendEvent);
294 procedure SetProportional(AValue: Boolean);
295 procedure SetRenderingParams(AValue: TChartRenderingParams);
296 procedure SetTitle(Value: TChartTitle);
297 procedure SetToolset(AValue: TBasicChartToolset);
298 procedure VisitSources(
299 AVisitor: TChartOnSourceVisitor; AAxis: TChartAxis; var AData);
300 protected
301 FDisablePopupMenu: Boolean;
302 procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
DoMouseWheelnull303 function DoMouseWheel(
304 AShift: TShiftState; AWheelDelta: Integer;
305 AMousePos: TPoint): Boolean; override;
306 procedure MouseDown(
307 Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
308 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
309 procedure MouseUp(
310 AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); override;
311 protected
GetAxisBoundsnull312 function GetAxisBounds(AAxis: TChartAxis): TDoubleInterval;
GetAxisByAlignnull313 function GetAxisByAlign(AAlign: TChartAxisAlignment): TChartAxis;
314 procedure SetAxisByAlign(AAlign: TChartAxisAlignment; AValue: TChartAxis); inline;
315 protected
316 procedure Clear(ADrawer: IChartDrawer; const ARect: TRect);
317 procedure DisplaySeries(ADrawer: IChartDrawer);
318 procedure DrawBackWall(ADrawer: IChartDrawer);
319 procedure KeyDownAfterInterface(var AKey: Word; AShift: TShiftState); override;
320 procedure KeyUpAfterInterface(var AKey: Word; AShift: TShiftState); override;
321 {$IFDEF LCLGtk2}
322 procedure DoOnResize; override;
323 {$ENDIF}
324 procedure Notification(
325 AComponent: TComponent; AOperation: TOperation); override;
326 procedure PrepareAxis(ADrawer: IChartDrawer);
PrepareLegendnull327 function PrepareLegend(
328 ADrawer: IChartDrawer; var AClipRect: TRect): TChartLegendDrawingData;
329 procedure RequestMultiPassScaling; inline;
330 procedure SetBiDiMode(AValue: TBiDiMode); override;
331 procedure SetName(const AValue: TComponentName); override;
332
333 public
334 constructor Create(AOwner: TComponent); override;
335 destructor Destroy; override;
336 procedure EraseBackground(DC: HDC); override;
337 procedure GetChildren(AProc: TGetChildProc; ARoot: TComponent); override;
338 procedure Paint; override;
339 procedure SetChildOrder(Child: TComponent; Order: Integer); override;
340
341 public // Helpers for series drawing
342 procedure DrawLineHoriz(ADrawer: IChartDrawer; AY: Integer);
343 procedure DrawLineVert(ADrawer: IChartDrawer; AX: Integer);
IsPointInViewPortnull344 function IsPointInViewPort(const AP: TDoublePoint): Boolean;
345
346 public
347 procedure AddSeries(ASeries: TBasicChartSeries);
348 procedure ClearSeries;
Clonenull349 function Clone: TChart; overload;
Clonenull350 function Clone(ANewOwner, ANewParent: TComponent): TChart; overload;
351 procedure CopyToClipboard(AClass: TRasterImageClass);
352 procedure CopyToClipboardBitmap;
353 procedure DeleteSeries(ASeries: TBasicChartSeries);
354 procedure DisableRedrawing;
355 procedure Draw(ADrawer: IChartDrawer; const ARect: TRect);
356 procedure DrawLegendOn(ACanvas: TCanvas; var ARect: TRect);
357 procedure EnableRedrawing;
358 procedure GetAllSeriesAxisLimits(AAxis: TChartAxis; out AMin, AMax: Double);
GetFullExtentnull359 function GetFullExtent: TDoubleRect;
GetLegendItemsnull360 function GetLegendItems(AIncludeHidden: Boolean = false): TChartLegendItems;
361 procedure Notify(ACommand: Integer; AParam1, AParam2: Pointer; var AData); override;
362 procedure PaintOnAuxCanvas(ACanvas: TCanvas; ARect: TRect);
363 procedure PaintOnCanvas(ACanvas: TCanvas; ARect: TRect);
364 procedure Prepare;
365 procedure RemoveSeries(ASeries: TBasicChartSeries); inline;
366 procedure SaveToBitmapFile(const AFileName: String); inline;
367 procedure SaveToFile(AClass: TRasterImageClass; AFileName: String);
SaveToImagenull368 function SaveToImage(AClass: TRasterImageClass): TRasterImage;
369 procedure StyleChanged(Sender: TObject); override;
UsesBuiltinToolsetnull370 function UsesBuiltinToolset: Boolean;
371 procedure ZoomFull(AImmediateRecalc: Boolean = false); override;
372 property Drawer: IChartDrawer read FConnectorData.FDrawer;
373
374 public // Coordinate conversion
GraphToImagenull375 function GraphToImage(const AGraphPoint: TDoublePoint): TPoint;
ImageToGraphnull376 function ImageToGraph(const APoint: TPoint): TDoublePoint;
XGraphToImagenull377 function XGraphToImage(AX: Double): Integer; inline;
XImageToGraphnull378 function XImageToGraph(AX: Integer): Double; inline;
YGraphToImagenull379 function YGraphToImage(AY: Double): Integer; inline;
YImageToGraphnull380 function YImageToGraph(AY: Integer): Double; inline;
381 property ScalingValid: Boolean read FScalingValid;
382
383 public
384 procedure LockClipRect;
385 procedure UnlockClipRect;
386
387 public
388 property ActiveToolIndex: Integer read FActiveToolIndex;
389 property Broadcaster: TBroadcaster read FBroadcaster;
390 property ChartHeight: Integer read GetChartHeight;
391 property ChartWidth: Integer read GetChartWidth;
392 property ClipRect: TRect read FClipRect;
393 property ClipRectBroadcaster: TBroadcaster read FClipRectBroadcaster;
394 property CurrentExtent: TDoubleRect read FCurrentExtent;
395 property ExtentBroadcaster: TBroadcaster read FExtentBroadcaster;
396 property FullExtentBroadcaster: TBroadcaster read FFullExtentBroadcaster;
397 property HorAxis: TChartAxis read GetHorAxis;
398 property IsZoomed: Boolean read FIsZoomed;
399 property LogicalExtent: TDoubleRect read FLogicalExtent write SetLogicalExtent;
400 property MinDataSpace: Integer
401 read FMinDataSpace write SetMinDataSpace; // default DEF_MIN_DATA_SPACE;
402 property OnChartPaint: TChartPaintEvent
403 read FOnChartPaint write SetOnChartPaint; experimental;
404 property PrevLogicalExtent: TDoubleRect read FPrevLogicalExtent;
405 property RenderingParams: TChartRenderingParams
406 read GetRenderingParams write SetRenderingParams;
407 property SeriesCount: Integer read GetSeriesCount;
408 property VertAxis: TChartAxis read GetVertAxis;
409 property XGraphMax: Double read FCurrentExtent.b.X;
410 property XGraphMin: Double read FCurrentExtent.a.X;
411 property YGraphMax: Double read FCurrentExtent.b.Y;
412 property YGraphMin: Double read FCurrentExtent.a.Y;
413
414 published
415 property AutoFocus: Boolean read FAutoFocus write FAutoFocus default false;
416 property AllowPanning: Boolean read FAllowPanning write FAllowPanning default true;
417 property AllowZoom: Boolean read FAllowZoom write FAllowZoom default true;
418 property AntialiasingMode: TChartAntialiasingMode
419 read FAntialiasingMode write SetAntialiasingMode default amDontCare;
420 property AxisList: TChartAxisList read FAxisList write SetAxisList;
421 property AxisVisible: Boolean read FAxisVisible write SetAxisVisible default true;
422 property BackColor: TColor read FBackColor write SetBackColor default clWindow;
423 property BottomAxis: TChartAxis index calBottom read GetAxisByAlign write SetAxisByAlign stored false;
424 property Depth: TChartDistance read FDepth write SetDepth default 0;
425 property ExpandPercentage: Integer
426 read FExpandPercentage write SetExpandPercentage default 0;
427 property Extent: TChartExtent read FExtent write SetExtent;
428 property ExtentSizeLimit: TChartExtent read FExtentSizeLimit write SetExtentSizeLimit;
429 property Foot: TChartTitle read FFoot write SetFoot;
430 property Frame: TChartPen read FFrame write SetFrame;
431 property GUIConnector: TChartGUIConnector
432 read FGUIConnector write SetGUIConnector;
433 property LeftAxis: TChartAxis index calLeft read GetAxisByAlign write SetAxisByAlign stored false;
434 property Legend: TChartLegend read FLegend write SetLegend;
435 property Margins: TChartMargins read FMargins write SetMargins;
436 property MarginsExternal: TChartMargins
437 read FMarginsExternal write SetMarginsExternal;
438 property Proportional: Boolean
439 read FProportional write SetProportional default false;
440 property Series: TChartSeriesList read FSeries;
441 property Title: TChartTitle read FTitle write SetTitle;
442 property Toolset: TBasicChartToolset read FToolset write SetToolset;
443
444 published
445 property OnAfterCustomDrawBackground: TChartAfterCustomDrawEvent
446 read FOnAfterCustomDrawBackground write SetOnAfterCustomDrawBackground;
447 property OnAfterCustomDrawBackWall: TChartAfterCustomDrawEvent
448 read FOnAfterCustomDrawBackWall write SetOnAfterCustomDrawBackWall;
449 property OnAfterDraw: TChartDrawEvent read FOnAfterDraw write SetOnAfterDraw;
450 deprecated 'Use OnAfterCustomDraw instead';
451 property OnAfterDrawBackground: TChartAfterDrawEvent
452 read FOnAfterDrawBackground write SetOnAfterDrawBackground;
453 deprecated 'Use OnAfterCustomDrawBackground instead';
454 property OnAfterDrawBackWall: TChartAfterDrawEvent
455 read FOnAfterDrawBackWall write SetOnAfterDrawBackWall;
456 deprecated 'Use OnAfterCustomDrawBackWall instead';
457 property OnAfterPaint: TChartEvent read FOnAfterPaint write FOnAfterPaint;
458 property OnBeforeCustomDrawBackground: TChartBeforeCustomDrawEvent
459 read FOnBeforeCustomDrawBackground write SetOnBeforeCustomDrawBackground;
460 property OnBeforeDrawBackground: TChartBeforeDrawEvent
461 read FOnBeforeDrawBackground write SetOnBeforeDrawBackground;
462 deprecated 'Use OnBeforeCustomDrawBackground instead';
463 property OnBeforeCustomDrawBackWall: TChartBeforeCustomDrawEvent
464 read FOnBeforeCustomDrawBackWall write SetOnBeforeCustomDrawBackwall;
465 property OnBeforeDrawBackWall: TChartBeforeDrawEvent
466 read FOnBeforeDrawBackWall write SetOnBeforeDrawBackWall;
467 deprecated 'Use OnBeforeCustomDrawBackWall instead';
468 property OnDrawLegend: TChartDrawLegendEvent
469 read FOnDrawLegend write SetOnDrawLegend;
470 property OnExtentChanged: TChartEvent
471 read FOnExtentChanged write FOnExtentChanged;
472 property OnExtentChanging: TChartEvent
473 read FOnExtentChanging write FOnExtentChanging;
474 deprecated 'Used OnExtentValidate instead';
475 property OnExtentValidate: TChartExtentValidateEvent
476 read FOnExtentValidate write FOnExtentValidate;
477 property OnFullExtentChanged: TChartEvent
478 read FOnFullExtentChanged write FOnFullExtentChanged;
479
480 published
481 property Align;
482 property Anchors;
483 property BiDiMode;
484 property BorderSpacing;
485 property Color default clForm;
486 property Constraints;
487 property DoubleBuffered;
488 property DragCursor;
489 property DragMode;
490 property Enabled;
491 property ParentBiDiMode;
492 property ParentColor default false;
493 property ParentShowHint;
494 property PopupMenu;
495 property ShowHint;
496 property Visible;
497
498 published
499 property OnClick;
500 property OnContextPopup;
501 property OnDblClick;
502 property OnDragDrop;
503 property OnDragOver;
504 property OnEndDrag;
505 property OnMouseDown;
506 property OnMouseEnter;
507 property OnMouseLeave;
508 property OnMouseMove;
509 property OnMouseUp;
510 property OnResize;
511 property OnStartDrag;
512 end;
513
514 procedure Register;
515 procedure RegisterSeriesClass(ASeriesClass: TSeriesClass; const ACaption: String); overload;
516 procedure RegisterSeriesClass(ASeriesClass: TSeriesClass; ACaptionPtr: PStr); overload;
517
518 var
519 SeriesClassRegistry: TClassRegistry = nil;
Chartnull520 OnInitBuiltinTools: function(AChart: TChart): TBasicChartToolset = nil;
521
522 implementation
523
524 {$R tagraph.res}
525
526 uses
527 Clipbrd, Dialogs, GraphMath, LCLProc, LResources, Math, Types,
528 TADrawerCanvas, TAGeometry, TAMath, TAStyles;
529
530 const
531 SScalingNotInitialized = '[%s.%s]: Image-graph scaling not yet initialized.';
532 SNestedSetLogicalExtentCall = '%s: Don''t set LogicalExtent in OnExtentValidate handler - modify %s parameter instead.';
533
CompareZPositionnull534 function CompareZPosition(AItem1, AItem2: Pointer): Integer;
535 begin
536 Result :=
537 TBasicChartSeries(AItem1).ZPosition - TBasicChartSeries(AItem2).ZPosition;
538 end;
539
540 procedure Register;
541 var
542 i: Integer;
543 sc: TSeriesClass;
544 begin
545 RegisterComponents(CHART_COMPONENT_IDE_PAGE, [TChart]);
546 for i := 0 to SeriesClassRegistry.Count - 1 do begin
547 sc := TSeriesClass(SeriesClassRegistry.GetClass(i));
548 RegisterClass(sc);
549 RegisterNoIcon([sc]);
550 end;
551 end;
552
553 procedure RegisterSeriesClass(ASeriesClass: TSeriesClass; const ACaption: String);
554 begin
555 if SeriesClassRegistry.IndexOfClass(ASeriesClass) < 0 then
556 SeriesClassRegistry.Add(TClassRegistryItem.Create(ASeriesClass, ACaption));
557 end;
558
559 procedure RegisterSeriesClass(ASeriesClass: TSeriesClass; ACaptionPtr: PStr);
560 begin
561 if SeriesClassRegistry.IndexOfClass(ASeriesClass) < 0 then
562 SeriesClassRegistry.Add(TClassRegistryItem.CreateRes(ASeriesClass, ACaptionPtr));
563 end;
564
565 procedure WriteComponentToStream(AStream: TStream; AComponent: TComponent);
566 var
567 writer: TWriter;
568 destroyDriver: Boolean = false;
569 begin
570 writer := CreateLRSWriter(AStream, destroyDriver);
571 try
572 writer.Root := AComponent.Owner;
573 writer.WriteComponent(AComponent);
574 finally
575 if destroyDriver then
576 writer.Driver.Free;
577 writer.Free;
578 end;
579 end;
580
581 { TBasicChartSeriesEnumerator }
582
GetCurrentnull583 function TBasicChartSeriesEnumerator.GetCurrent: TBasicChartSeries;
584 begin
585 Result := TBasicChartSeries(inherited GetCurrent);
586 end;
587
588 { TChart }
589
590 procedure TChart.AddSeries(ASeries: TBasicChartSeries);
591 begin
592 if ASeries.FChart = Self then exit;
593 if ASeries.FChart <> nil then
594 ASeries.FChart.DeleteSeries(ASeries);
595 Series.FList.Add(ASeries);
596 ASeries.FChart := Self;
597 ASeries.AfterAdd;
598 StyleChanged(ASeries);
599 end;
600
601 procedure TChart.CalculateTransformationCoeffs(const AMargin, AChartMargins: TRect;
602 const AMinDataSpace: Integer);
603 var
604 rX, rY: TAxisCoeffHelper;
605 begin
606 rX.Init(
607 HorAxis, FClipRect.Left, FClipRect.Right, AMargin.Left, -AMargin.Right,
608 AChartMargins.Left, AChartMargins.Right, AMinDataSpace,
609 false, @FCurrentExtent.a.X, @FCurrentExtent.b.X);
610 rY.Init(
611 VertAxis, FClipRect.Bottom, FClipRect.Top, -AMargin.Bottom, AMargin.Top,
612 AChartMargins.Bottom, AChartMargins.Top, AMinDataSpace,
613 true, @FCurrentExtent.a.Y, @FCurrentExtent.b.Y);
614
615 FScale.X := rX.CalcScale(1);
616 FScale.Y := rY.CalcScale(-1);
617 if Proportional then begin
618 if Abs(FScale.X) > Abs(FScale.Y) then
619 FScale.X := Abs(FScale.Y) * Sign(FScale.X)
620 else
621 FScale.Y := Abs(FScale.X) * Sign(FScale.Y);
622 end;
623 FOffset.X := rX.CalcOffset(FScale.X);
624 FOffset.Y := rY.CalcOffset(FScale.Y);
625 FOffsetInt := Point(0, 0);
626 FScalingValid := True;
627 rX.UpdateMinMax(@XImageToGraph);
628 rY.UpdateMinMax(@YImageToGraph);
629 end;
630
631 procedure TChart.Clear(ADrawer: IChartDrawer; const ARect: TRect);
632 var
633 defaultDrawing: Boolean = true;
634 ic: IChartTCanvasDrawer;
635 begin
636 ADrawer.PrepareSimplePen(Color);
637 ADrawer.SetBrushParams(bsSolid, Color);
638
639 if Assigned(FOnBeforeCustomDrawBackground) then
640 OnBeforeCustomDrawBackground(Self, ADrawer, ARect, defaultDrawing)
641 else
642 if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnBeforeDrawBackground) then
643 OnBeforeDrawBackground(Self, ic.Canvas, ARect, defaultDrawing);
644
645 if defaultDrawing then
646 ADrawer.FillRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
647 // ADrawer.Rectangle(ARect);
648
649 if Assigned(OnAfterCustomDrawBackground) then
650 OnAfterCustomDrawBackground(Self, ADrawer, ARect);
651 if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnAfterDrawBackground) then
652 OnAfterDrawBackground(Self, ic.Canvas, ARect);
653 end;
654
655 procedure TChart.ClearSeries;
656 begin
657 FSeries.Clear;
658 StyleChanged(Self);
659 end;
660
ClipRectWithoutFramenull661 function TChart.ClipRectWithoutFrame(AZPosition: TChartDistance): TRect;
662 begin
663 Result := FClipRect;
664 if (AZPosition > 0) or not Frame.EffVisible then exit;
665 Result.Left += (Frame.Width + 1) div 2;
666 Result.Top += (Frame.Width + 1) div 2;
667 Result.Bottom -= Frame.Width div 2;
668 Result.Right -= Frame.Width div 2;
669 end;
670
TChart.Clonenull671 function TChart.Clone: TChart;
672 begin
673 Result := Clone(Owner, Parent);
674 end;
675
TChart.Clonenull676 function TChart.Clone(ANewOwner, ANewParent: TComponent): TChart;
677 var
678 ms: TMemoryStream;
679 cloned: TComponent = nil;
680 begin
681 ms := TMemoryStream.Create;
682 try
683 WriteComponentToStream(ms, Self);
684 ms.Seek(0, soBeginning);
685 ReadComponentFromBinaryStream(
686 ms, cloned, @FindComponentClass, ANewOwner, ANewParent, Owner);
687 Result := cloned as TChart;
688 finally
689 ms.Free;
690 end;
691 end;
692
693 procedure TChart.CopyToClipboard(AClass: TRasterImageClass);
694 begin
695 with SaveToImage(AClass) do
696 try
697 SaveToClipboardFormat(RegisterClipboardFormat(MimeType));
698 finally
699 Free;
700 end;
701 end;
702
703 procedure TChart.CopyToClipboardBitmap;
704 begin
705 CopyToClipboard(TBitmap);
706 end;
707
708 constructor TChart.Create(AOwner: TComponent);
709 const
710 DEFAULT_CHART_WIDTH = 300;
711 DEFAULT_CHART_HEIGHT = 200;
712 DEFAULT_CHART_TITLE = 'TAChart';
713 FONT_VERTICAL = 900;
714 begin
715 inherited Create(AOwner);
716
717 FBroadcaster := TBroadcaster.Create;
718 FClipRectBroadcaster := TBroadcaster.Create;
719 FExtentBroadcaster := TBroadcaster.Create;
720 FFullExtentBroadcaster := TBroadcaster.Create;
721 FAllowZoom := true;
722 FAllowPanning := true;
723 FAntialiasingMode := amDontCare;
724 FAxisVisible := true;
725 FConnectorData.FCanvas := Canvas;
726 FDefaultGUIConnector := TChartGUIConnectorCanvas.Create(Self);
727 FDefaultGUIConnector.CreateDrawer(FConnectorData);
728 FGUIConnectorListener := TListener.Create(@FGUIConnector, @StyleChanged);
729
730 FScale := DoublePoint(1, -1);
731 FScalingValid := False;
732 FMultiPassScalingNeeded := False;
733
734 Width := DEFAULT_CHART_WIDTH;
735 Height := DEFAULT_CHART_HEIGHT;
736
737 FSeries := TChartSeriesList.Create;
738 Color := clForm;
739 FBackColor := clWindow;
740 FIsZoomed := false;
741 FLegend := TChartLegend.Create(Self);
742
743 FTitle := TChartTitle.Create(Self);
744 FTitle.Alignment := taCenter;
745 FTitle.Text.Add(DEFAULT_CHART_TITLE);
746 FFoot := TChartTitle.Create(Self);
747
748 FAxisList := TChartAxisList.Create(Self);
749 FAxisList.OnVisitSources := @VisitSources;
750 with TChartAxis.Create(FAxisList) do begin
751 Alignment := calLeft;
752 Title.LabelFont.Orientation := FONT_VERTICAL;
753 end;
754 with TChartAxis.Create(FAxisList) do
755 Alignment := calBottom;
756
757 FFrame := TChartPen.Create;
758 FFrame.OnChange := @StyleChanged;
759
760 FExtent := TChartExtent.Create(Self);
761 FExtentSizeLimit := TChartExtent.Create(Self);
762 FMargins := TChartMargins.Create(Self);
763 FMarginsExternal := TChartMargins.Create(Self);
764 FMinDataSpace := DEF_MIN_DATA_SPACE;
765
766 if OnInitBuiltinTools <> nil then
767 FBuiltinToolset := OnInitBuiltinTools(Self);
768 FActiveToolIndex := -1;
769
770 FLogicalExtent := EmptyExtent;
771 FPrevLogicalExtent := EmptyExtent;
772 FPrevFullExtent := EmptyExtent;
773 end;
774
775 procedure TChart.DeleteSeries(ASeries: TBasicChartSeries);
776 var
777 i: Integer;
778 begin
779 i := FSeries.FList.IndexOf(ASeries);
780 if i < 0 then exit;
781 FSeries.FList.Delete(i);
782 ASeries.FChart := nil;
783 StyleChanged(Self);
784 end;
785
786 destructor TChart.Destroy;
787 begin
788 FreeAndNil(FSeries);
789
790 FreeAndNil(FLegend);
791 FreeAndNil(FTitle);
792 FreeAndNil(FFoot);
793 FreeAndNil(FAxisList);
794 FreeAndNil(FFrame);
795 FreeAndNil(FGUIConnectorListener);
796 FreeAndNil(FExtent);
797 FreeAndNil(FExtentSizeLimit);
798 FreeAndNil(FMargins);
799 FreeAndNil(FMarginsExternal);
800 FreeAndNil(FBuiltinToolset);
801 FreeAndNil(FBroadcaster);
802 FreeAndNil(FClipRectBroadcaster);
803 FreeAndNil(FExtentBroadcaster);
804 FreeAndNil(FFullExtentBroadcaster);
805 FreeAndNil(FDefaultGUIConnector);
806
807 DrawData.DeleteByChart(Self);
808 inherited;
809 end;
810
811 procedure TChart.DisableRedrawing;
812 begin
813 FDisableRedrawingCounter += 1;
814 end;
815
816 procedure TChart.DisplaySeries(ADrawer: IChartDrawer);
817
818 procedure OffsetDrawArea(ADX, ADY: Integer); inline;
819 begin
820 FOffsetInt.X += ADX;
821 FOffsetInt.Y += ADY;
822 OffsetRect(FClipRect, ADX, ADY);
823 end;
824
825 procedure OffsetWithDepth(AZPos, ADepth: Integer);
826 begin
827 AZPos := ADrawer.Scale(AZPos);
828 ADepth := ADrawer.Scale(ADepth);
829 OffsetDrawArea(-AZPos, AZPos);
830 FClipRect.Right += ADepth;
831 FClipRect.Top -= ADepth;
832 end;
833
834 procedure DrawOrDeactivate(
835 ASeries: TBasicChartSeries; ATransparency: TChartTransparency);
836 begin
837 try
838 ADrawer.SetTransparency(ATransparency);
839 ASeries.Draw(ADrawer);
840 except
841 ASeries.Active := false;
842 raise;
843 end;
844 end;
845
846 var
847 axisIndex: Integer;
848 seriesInZOrder: TChartSeriesList;
849 s: TBasicChartSeries;
850 begin
851 axisIndex := 0;
852 if SeriesCount > 0 then begin
853 seriesInZOrder := TChartSeriesList.Create;
854 try
855 seriesInZOrder.List.Assign(FSeries.List);
856 seriesInZOrder.List.Sort(@CompareZPosition);
857
858 for s in seriesInZOrder do begin
859 if not s.Active then continue;
860 // Interleave axes with series according to ZPosition.
861 if AxisVisible then
862 AxisList.Draw(s.ZPosition, axisIndex);
863 OffsetWithDepth(Min(s.ZPosition, Depth), Min(s.Depth, Depth));
864 ADrawer.ClippingStart(ClipRectWithoutFrame(s.ZPosition));
865
866 try
867 with s.Shadow do
868 if Visible then begin
869 OffsetDrawArea(OffsetX, OffsetY);
870 ADrawer.SetMonochromeColor(Color);
871 try
872 DrawOrDeactivate(s, Transparency);
873 finally
874 ADrawer.SetMonochromeColor(clTAColor);
875 OffsetDrawArea(-OffsetX, -OffsetY);
876 end;
877 end;
878 DrawOrDeactivate(s, s.Transparency);
879 finally
880 OffsetWithDepth(-Min(s.ZPosition, Depth), -Min(s.Depth, Depth));
881 ADrawer.ClippingStop;
882 end;
883 end;
884 finally
885 seriesInZOrder.List.Clear; // Avoid freeing series.
886 seriesInZOrder.Free;
887 ADrawer.SetTransparency(0);
888 end;
889 end;
890 if AxisVisible then
891 AxisList.Draw(MaxInt, axisIndex);
892 end;
893
894 procedure TChart.DoContextPopup(MousePos: TPoint; var Handled: Boolean);
895 begin
896 if FDisablePopupMenu then Handled := true;
897 inherited;
898 end;
899
TChart.DoMouseWheelnull900 function TChart.DoMouseWheel(
901 AShift: TShiftState; AWheelDelta: Integer; AMousePos: TPoint): Boolean;
902 const
903 EV: array [Boolean] of TChartToolEventId = (
904 evidMouseWheelDown, evidMouseWheelUp);
905 var
906 ts: TBasicChartToolset;
907 begin
908 ts := GetToolset;
909 if ts = nil then
910 result := false
911 else
912 Result := ts.Dispatch(Self, EV[AWheelDelta > 0], AShift, AMousePos) or
913 inherited DoMouseWheel(AShift, AWheelDelta, AMousePos);
914 end;
915
916 {$IFDEF LCLGtk2}
917 procedure TChart.DoOnResize;
918 begin
919 inherited;
920 // FIXME: GTK does not invalidate the control on resizing, do it manually
921 Invalidate;
922 end;
923 {$ENDIF}
924
925 procedure TChart.Draw(ADrawer: IChartDrawer; const ARect: TRect);
926 var
927 NewClipRect: TRect;
928 ldd: TChartLegendDrawingData;
929 tmpExtent: TDoubleRect;
930 tries: Integer;
931 s: TBasicChartSeries;
932 ts: TBasicChartToolset;
933 begin
934 ADrawer.SetRightToLeft(BiDiMode <> bdLeftToRight);
935
936 NewClipRect := ARect;
937 with NewClipRect do begin
938 Left += MarginsExternal.Left;
939 Top += MarginsExternal.Top;
940 Right -= MarginsExternal.Right;
941 Bottom -= MarginsExternal.Bottom;
942 FTitle.Measure(ADrawer, 1, Left, Right, Top);
943 FFoot.Measure(ADrawer, -1, Left, Right, Bottom);
944 end;
945
946 ldd.FItems := nil;
947 try
948 Prepare;
949
950 if Legend.Visible then
951 ldd := PrepareLegend(ADrawer, NewClipRect);
952
953 for tries := 3 downto 0 do
954 begin
955 FClipRect := NewClipRect;
956
957 PrepareAxis(ADrawer);
958
959 if (tries = 0) or (not FMultiPassScalingNeeded) then break;
960
961 // FIsZoomed=true: GetFullExtent() has not been called in Prepare() above
962 if FIsZoomed then break;
963
964 // Perform a next pass of extent calculation
965 tmpExtent := GetFullExtent;
966 // Converged successfully if next pass has not changed the extent --> break
967 if tmpExtent = FLogicalExtent then break;
968
969 // As in the Prepare() call above
970 FLogicalExtent := tmpExtent;
971 FCurrentExtent := FLogicalExtent;
972 end;
973
974 // Avoid calculation of the full extent when not needed
975 // This extent calculation must be inside the series.BeforeDraw (--> Prepare)
976 // and series.AfterDraw block (DBChartSource issue #39313)
977 if FullExtentBroadcastActive then
978 FBufferedFullExtent := GetFullExtent;
979
980 if Legend.Visible and not Legend.UseSidebar then
981 Legend.Prepare(ldd, FClipRect);
982
983 // Avoid jitter of chart area while dragging with PanDragTool.
984 if FClipRectLock > 0 then
985 FClipRect := FSavedClipRect;
986
987 if (FPrevLogicalExtent <> FLogicalExtent) and Assigned(OnExtentChanging) then
988 OnExtentChanging(Self);
989
990 ADrawer.DrawingBegin(ARect);
991 ADrawer.SetAntialiasingMode(AntialiasingMode);
992 Clear(ADrawer, ARect);
993 FTitle.Draw(ADrawer);
994 FFoot.Draw(ADrawer);
995 DrawBackWall(ADrawer);
996 DisplaySeries(ADrawer);
997 if Legend.Visible then begin
998 if Assigned(FOnDrawLegend) then
999 FOnDrawlegend(Self, ldd.FDrawer, ldd.FItems, ldd.FItemSize, ldd.FBounds,
1000 ldd.FColCount, ldd.FRowCount)
1001 else
1002 Legend.Draw(ldd);
1003 end;
1004 finally
1005 ldd.FItems.Free;
1006 end;
1007 ts := GetToolset;
1008 if ts <> nil then ts.Draw(Self, ADrawer);
1009
1010 for s in Series do
1011 s.AfterDraw;
1012
1013 if Assigned(OnAfterDraw) then
1014 OnAfterDraw(Self, ADrawer);
1015 ADrawer.DrawingEnd;
1016
1017 if FullExtentBroadcastActive and (FPrevFullExtent <> FBufferedFullExtent) then
1018 begin
1019 FFullExtentBroadcaster.Broadcast(Self);
1020 if Assigned(OnFullExtentChanged) then
1021 OnFullExtentChanged(Self);
1022 FPrevFullExtent := FBufferedFullExtent;
1023 end;
1024
1025 if FPrevLogicalExtent <> FLogicalExtent then begin
1026 FExtentBroadcaster.Broadcast(Self);
1027 if Assigned(OnExtentChanged) then
1028 OnExtentChanged(Self);
1029 FPrevLogicalExtent := FLogicalExtent;
1030 end;
1031
1032 if FClipRect <> FOldClipRect then
1033 begin
1034 FClipRectBroadcaster.Broadcast(Self);
1035 FOldClipRect := FClipRect;
1036 end;
1037
1038 // Undo changes made by the drawer (mainly for printing). The user may print
1039 // something else after the chart and, for example, would not expect the font
1040 // to be rotated (Fix for issue #0027163) or the pen to be in xor mode.
1041 ADrawer.ResetFont;
1042 ADrawer.SetXor(false);
1043 ADrawer.PrepareSimplePen(clBlack); // resets canvas pen mode to pmCopy
1044 ADrawer.SetPenParams(psSolid, clDefault);
1045 ADrawer.SetBrushParams(bsSolid, clWhite);
1046 ADrawer.SetAntialiasingMode(amDontCare);
1047 end;
1048
1049 procedure TChart.DrawBackWall(ADrawer: IChartDrawer);
1050 var
1051 defaultDrawing: Boolean = true;
1052 ic: IChartTCanvasDrawer;
1053 scaled_depth: Integer;
1054 clr: TColor;
1055 begin
1056 if Assigned(OnBeforeCustomDrawBackWall) then
1057 OnBeforeCustomDrawBackWall(self, ADrawer, FClipRect, defaultDrawing)
1058 else
1059 if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnBeforeDrawBackWall) then
1060 OnBeforeDrawBackWall(Self, ic.Canvas, FClipRect, defaultDrawing);
1061
1062 if defaultDrawing then
1063 with ADrawer do begin
1064 if FFrame.Visible then
1065 begin
1066 Pen := FFrame;
1067 if FFrame.Color = clDefault then
1068 SetPenColor(GetDefaultColor(dctFont));
1069 end
1070 else
1071 SetPenParams(psClear, clTAColor);
1072 if BackColor = clDefault then
1073 clr := GetDefaultColor(dctBrush)
1074 else
1075 clr := BackColor;
1076 SetBrushParams(bsSolid, clr);
1077 with FClipRect do
1078 Rectangle(Left, Top, Right + 1, Bottom + 1);
1079 end;
1080
1081 if Assigned(OnAfterCustomDrawBackWall) then
1082 OnAfterCustomDrawBackwall(Self, ADrawer, FClipRect);
1083 if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnAfterDrawBackWall) then
1084 OnAfterDrawBackWall(Self, ic.Canvas, FClipRect);
1085
1086 // Z axis
1087 if (Depth > 0) and FFrame.Visible then begin
1088 scaled_depth := ADrawer.Scale(Depth);
1089 ADrawer.Pen := FFrame;
1090 with FClipRect do
1091 ADrawer.Line(Left, Bottom, Left - scaled_depth, Bottom + scaled_depth);
1092 end;
1093 end;
1094
1095 procedure TChart.DrawLegendOn(ACanvas: TCanvas; var ARect: TRect);
1096 var
1097 ldd: TChartLegendDrawingData;
1098 begin
1099 ldd := PrepareLegend(TCanvasDrawer.Create(ACanvas), ARect);
1100 try
1101 Legend.Draw(ldd);
1102 finally
1103 ldd.FItems.Free;
1104 end;
1105 end;
1106
1107 procedure TChart.DrawLineHoriz(ADrawer: IChartDrawer; AY: Integer);
1108 begin
1109 if (FClipRect.Top < AY) and (AY < FClipRect.Bottom) then
1110 ADrawer.Line(FClipRect.Left, AY, FClipRect.Right, AY);
1111 end;
1112
1113 procedure TChart.DrawLineVert(ADrawer: IChartDrawer; AX: Integer);
1114 begin
1115 if (FClipRect.Left < AX) and (AX < FClipRect.Right) then
1116 ADrawer.Line(AX, FClipRect.Top, AX, FClipRect.Bottom);
1117 end;
1118
TChart.EffectiveGUIConnectornull1119 function TChart.EffectiveGUIConnector: TChartGUIConnector;
1120 begin
1121 Result := TChartGUIConnector(
1122 IfThen(FGUIConnector = nil, FDefaultGUIConnector, FGUIConnector));
1123 end;
1124
1125 procedure TChart.EnableRedrawing;
1126 begin
1127 FDisableRedrawingCounter -= 1;
1128 end;
1129
1130 procedure TChart.EraseBackground(DC: HDC);
1131 begin
1132 // do not erase, since we will paint over it anyway
1133 Unused(DC);
1134 end;
1135
1136 procedure TChart.FindComponentClass(
1137 AReader: TReader; const AClassName: String; var AClass: TComponentClass);
1138 var
1139 i: Integer;
1140 begin
1141 Unused(AReader);
1142 if AClassName = ClassName then begin
1143 AClass := TChart;
1144 exit;
1145 end;
1146 for i := 0 to SeriesClassRegistry.Count - 1 do begin
1147 AClass := TSeriesClass(SeriesClassRegistry.GetClass(i));
1148 if AClass.ClassNameIs(AClassName) then exit;
1149 end;
1150 AClass := nil;
1151 end;
1152
TChart.FullExtentBroadcastActivenull1153 function TChart.FullExtentBroadcastActive: Boolean;
1154 begin
1155 Result := (FFullExtentBroadcaster.Count > 0) or Assigned(FOnFullExtentChanged);
1156 end;
1157
1158 procedure TChart.GetAllSeriesAxisLimits(AAxis: TChartAxis; out AMin, AMax: Double);
1159 var
1160 interval: TDoubleInterval;
1161 begin
1162 interval := GetAxisBounds(AAxis);
1163 AMin := interval.FStart;
1164 AMax := interval.FEnd;
1165 end;
1166
TChart.GetAxisBoundsnull1167 function TChart.GetAxisBounds(AAxis: TChartAxis): TDoubleInterval;
1168 var
1169 s: TBasicChartSeries;
1170 mn, mx: Double;
1171 begin
1172 Result.FStart := SafeInfinity;
1173 Result.FEnd := NegInfinity;
1174 for s in Series do
1175 if s.Active and s.GetAxisBounds(AAxis, mn, mx) then begin
1176 Result.FStart := Min(Result.FStart, mn);
1177 Result.FEnd := Max(Result.FEnd, mx);
1178 end;
1179 end;
1180
TChart.GetAxisByAlignnull1181 function TChart.GetAxisByAlign(AAlign: TChartAxisAlignment): TChartAxis;
1182 begin
1183 if (BidiMode <> bdLeftToRight) then
1184 case AAlign of
1185 calLeft: AAlign := calRight;
1186 calRight: AAlign := calLeft;
1187 else ;
1188 end;
1189 Result := FAxisList.GetAxisByAlign(AAlign);
1190 end;
1191
GetChartHeightnull1192 function TChart.GetChartHeight: Integer;
1193 begin
1194 Result := FClipRect.Bottom - FClipRect.Top;
1195 end;
1196
GetChartWidthnull1197 function TChart.GetChartWidth: Integer;
1198 begin
1199 Result := FClipRect.Right - FClipRect.Left;
1200 end;
1201
1202 procedure TChart.GetChildren(AProc: TGetChildProc; ARoot: TComponent);
1203 var
1204 s: TBasicChartSeries;
1205 begin
1206 // FIXME: This is a workaround for issue #16035
1207 if FSeries = nil then exit;
1208 for s in Series do
1209 if s.Owner = ARoot then
1210 AProc(s);
1211 end;
1212
GetFullExtentnull1213 function TChart.GetFullExtent: TDoubleRect;
1214
1215 procedure SetBounds(
1216 var ALo, AHi: Double; AMin, AMax: Double; AUseMin, AUseMax: Boolean);
1217 const
1218 DEFAULT_WIDTH = 2.0;
1219 begin
1220 if AUseMin then ALo := AMin;
1221 if AUseMax then AHi := AMax;
1222 case CASE_OF_TWO[IsInfinite(ALo), IsInfinite(AHi)] of
1223 cotNone: begin // Both high and low boundary defined
1224 if ALo = AHi then begin
1225 ALo -= DEFAULT_WIDTH / 2;
1226 AHi += DEFAULT_WIDTH / 2;
1227 end
1228 else begin
1229 EnsureOrder(ALo, AHi);
1230 // Expand view slightly to avoid data points on the chart edge.
1231 ExpandRange(ALo, AHi, ExpandPercentage * PERCENT);
1232 end;
1233 end;
1234 cotFirst: ALo := AHi - DEFAULT_WIDTH;
1235 cotSecond: AHi := ALo + DEFAULT_WIDTH;
1236 cotBoth: begin // No boundaries defined, take some arbitrary values
1237 ALo := -DEFAULT_WIDTH / 2;
1238 AHi := DEFAULT_WIDTH / 2;
1239 end;
1240 end;
1241 end;
1242
1243 procedure JoinBounds(const ABounds: TDoubleRect);
1244 begin
1245 with Result do begin
1246 a.X := Min(a.X, ABounds.a.X);
1247 b.X := Max(b.X, ABounds.b.X);
1248 a.Y := Min(a.Y, ABounds.a.Y);
1249 b.Y := Max(b.Y, ABounds.b.Y);
1250 end;
1251 end;
1252
1253 var
1254 axisBounds: TDoubleRect;
1255 s: TBasicChartSeries;
1256 a: TChartAxis;
1257 begin
1258 //Extent.CheckBoundsOrder;
1259 // wp: avoid exception in IDE if min > max, but silently bring min/max
1260 // into correct order
1261
1262 for a in AxisList do
1263 if a.Transformations <> nil then
1264 a.Transformations.ClearBounds;
1265
1266 Result := EmptyExtent;
1267 for s in Series do begin
1268 try
1269 JoinBounds(s.GetGraphBounds);
1270 except
1271 s.Active := false;
1272 raise;
1273 end;
1274 end;
1275 for a in AxisList do begin
1276 axisBounds := EmptyExtent;
1277 if a.Range.UseMin then
1278 TDoublePointBoolArr(axisBounds.a)[a.IsVertical] :=
1279 a.GetTransform.AxisToGraph(a.Range.Min);
1280 if a.Range.UseMax then
1281 TDoublePointBoolArr(axisBounds.b)[a.IsVertical] :=
1282 a.GetTransform.AxisToGraph(a.Range.Max);
1283 JoinBounds(axisBounds);
1284 end;
1285 with Extent do begin
1286 SetBounds(Result.a.X, Result.b.X, XMin, XMax, UseXMin, UseXMax);
1287 SetBounds(Result.a.Y, Result.b.Y, YMin, YMax, UseYMin, UseYMax);
1288 end;
1289 end;
1290
GetHorAxisnull1291 function TChart.GetHorAxis: TChartAxis;
1292 begin
1293 Result := BottomAxis;
1294 if Result = nil then Result := GetAxisByAlign(calTop);
1295 end;
1296
TChart.GetLegendItemsnull1297 function TChart.GetLegendItems(AIncludeHidden: Boolean): TChartLegendItems;
1298 var
1299 s: TBasicChartSeries;
1300 begin
1301 Result := TChartLegendItems.Create;
1302 try
1303 for s in Series do
1304 if AIncludeHidden or (s.Active and s.GetShowInLegend) then
1305 try
1306 s.GetLegendItemsBasic(Result);
1307 except
1308 s.SetShowInLegend(AIncludeHidden);
1309 raise;
1310 end;
1311 except
1312 FreeAndNil(Result);
1313 raise;
1314 end;
1315 end;
1316
TChart.GetMarginsnull1317 function TChart.GetMargins(ADrawer: IChartDrawer): TRect;
1318 var
1319 i: Integer;
1320 a: TRectArray absolute Result;
1321 s: TBasicChartSeries;
1322 begin
1323 Result := ZeroRect;
1324 for s in Series do
1325 if s.Active then
1326 s.UpdateMargins(ADrawer, Result);
1327 for i := Low(a) to High(a) do
1328 a[i] := a[i] + ADrawer.Scale(TRectArray(Margins.Data)[i]);
1329 end;
1330
TChart.GetRenderingParamsnull1331 function TChart.GetRenderingParams: TChartRenderingParams;
1332 begin
1333 Result.FScale := FScale;
1334 Result.FOffset := FOffset;
1335 Result.FClipRect := FClipRect;
1336 Result.FLogicalExtent := FLogicalExtent;
1337 Result.FPrevLogicalExtent := FPrevLogicalExtent;
1338 Result.FIsZoomed := FIsZoomed;
1339 end;
1340
TChart.GetSeriesCountnull1341 function TChart.GetSeriesCount: Integer;
1342 begin
1343 Result := FSeries.FList.Count;
1344 end;
1345
TChart.GetToolsetnull1346 function TChart.GetToolset: TBasicChartToolset;
1347 begin
1348 Result := FToolset;
1349 if Result = nil then
1350 Result := FBuiltinToolset;
1351 end;
1352
TChart.GetVertAxisnull1353 function TChart.GetVertAxis: TChartAxis;
1354 begin
1355 Result := LeftAxis;
1356 if Result = nil then Result := GetAxisByAlign(calRight);
1357 end;
1358
TChart.GraphToImagenull1359 function TChart.GraphToImage(const AGraphPoint: TDoublePoint): TPoint;
1360 begin
1361 Result := Point(XGraphToImage(AGraphPoint.X), YGraphToImage(AGraphPoint.Y));
1362 end;
1363
TChart.ImageToGraphnull1364 function TChart.ImageToGraph(const APoint: TPoint): TDoublePoint;
1365 begin
1366 Result.X := XImageToGraph(APoint.X);
1367 Result.Y := YImageToGraph(APoint.Y);
1368 end;
1369
IsPointInViewPortnull1370 function TChart.IsPointInViewPort(const AP: TDoublePoint): Boolean;
1371 begin
1372 Result :=
1373 not IsNan(AP) and
1374 SafeInRangeWithBounds(AP.X, XGraphMin, XGraphMax) and
1375 SafeInRangeWithBounds(AP.Y, YGraphMin, YGraphMax);
1376 end;
1377
1378 procedure TChart.KeyDownAfterInterface(var AKey: Word; AShift: TShiftState);
1379 var
1380 p: TPoint;
1381 ts: TBasicChartToolset;
1382 begin
1383 p := ScreenToClient(Mouse.CursorPos);
1384 ts := GetToolset;
1385 if (ts <> nil) and ts.Dispatch(Self, evidKeyDown, AShift, p) then exit;
1386 inherited;
1387 end;
1388
1389 procedure TChart.KeyUpAfterInterface(var AKey: Word; AShift: TShiftState);
1390 var
1391 p: TPoint;
1392 ts: TBasicChartToolset;
1393 begin
1394 p := ScreenToClient(Mouse.CursorPos);
1395 // To find a tool, toolset must see the shift state with the key still down.
1396 case AKey of
1397 VK_CONTROL: AShift += [ssCtrl];
1398 VK_MENU: AShift += [ssAlt];
1399 VK_SHIFT: AShift += [ssShift];
1400 end;
1401 ts := GetToolset;
1402 if (ts <> nil) and ts.Dispatch(Self, evidKeyUp, AShift, p) then exit;
1403 inherited;
1404 end;
1405
1406 procedure TChart.LockClipRect;
1407 begin
1408 FSavedClipRect := FClipRect;
1409 inc(FClipRectLock);
1410 end;
1411
1412 procedure TChart.MouseDown(
1413 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1414 var
1415 ts: TBasicChartToolset;
1416 begin
1417 ts := GetToolset;
1418 if (ts <> nil) and ts.Dispatch(Self, evidMouseDown, Shift, Point(X, Y)) then
1419 exit;
1420 inherited;
1421 end;
1422
1423 procedure TChart.MouseMove(Shift: TShiftState; X, Y: Integer);
1424 var
1425 ts: TBasicChartToolset;
1426 begin
1427 if AutoFocus then
1428 SetFocus;
1429 ts := GetToolset;
1430 if (ts <> nil) and ts.Dispatch(Self, evidMouseMove, Shift, Point(X, Y)) then
1431 exit;
1432 inherited;
1433 end;
1434
1435 procedure TChart.MouseUp(
1436 AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer);
1437 const
1438 MOUSE_BUTTON_TO_SHIFT: array [TMouseButton] of TShiftStateEnum = (
1439 ssLeft, ssRight, ssMiddle, ssExtra1, ssExtra2);
1440 var
1441 ts: TBasicChartToolset;
1442 begin
1443 // To find a tool, toolset must see the shift state with the button still down.
1444 Include(AShift, MOUSE_BUTTON_TO_SHIFT[AButton]);
1445 ts := GetToolset;
1446 if (ts <> nil) and ts.Dispatch(Self, evidMouseUp, AShift, Point(AX, AY)) then
1447 exit;
1448 inherited;
1449 end;
1450
1451 procedure TChart.Notification(AComponent: TComponent; AOperation: TOperation);
1452 var
1453 ax: TChartAxis;
1454 begin
1455 if (AOperation = opRemove) and (AComponent = Toolset) then
1456 FToolset := nil
1457 else if (AOperation = opRemove) and (AComponent = GUIConnector) then
1458 GUIConnector := nil
1459 else if (AOperation = opRemove) and (AComponent is TChartStyles) then begin
1460 for ax in FAxisList do
1461 if ax.Marks.Stripes = AComponent then
1462 ax.Marks.Stripes := nil;
1463 end;
1464
1465 inherited Notification(AComponent, AOperation);
1466 end;
1467
1468 { Notifies the chart of something which is specified by ACommand and both
1469 parameters. Needed for example by the axis to query the extent covered by
1470 all series using this axis (cannot be called directly because TAChartAxis
1471 does not "use" TACustomSeries. }
1472
1473 procedure TChart.Notify(ACommand: Integer; AParam1, AParam2: Pointer; var AData);
1474 begin
1475 UnUsed(AParam2);
1476 case ACommand of
1477 CMD_QUERY_SERIESEXTENT:
1478 TDoubleInterval(AData) := GetAxisBounds(TChartAxis(AParam1));
1479 end;
1480 end;
1481
1482
1483 procedure TChart.Paint;
1484 var
1485 defaultDrawing: Boolean = true;
1486 begin
1487 FConnectorData.FBounds := GetClientRect;
1488 {$PUSH}
1489 {$WARNINGS OFF}
1490 if Assigned(OnChartPaint) then
1491 OnChartPaint(Self, FConnectorData.FBounds, defaultDrawing);
1492 {$POP}
1493 if defaultDrawing then
1494 with EffectiveGUIConnector do begin
1495 SetBounds(FConnectorData);
1496 Draw(Drawer, FConnectorData.FDrawerBounds);
1497 EffectiveGUIConnector.Display(FConnectorData);
1498 end;
1499 if Assigned(OnAfterPaint) then
1500 OnAfterPaint(Self);
1501 end;
1502
1503 procedure TChart.PaintOnAuxCanvas(ACanvas: TCanvas; ARect: TRect);
1504 var
1505 rp: TChartRenderingParams;
1506 begin
1507 rp := RenderingParams;
1508 ExtentBroadcaster.Locked := true;
1509 try
1510 FIsZoomed := false;
1511 PaintOnCanvas(ACanvas, ARect);
1512 finally
1513 RenderingParams := rp;
1514 ExtentBroadcaster.Locked := false;
1515 end;
1516 end;
1517
1518 procedure TChart.PaintOnCanvas(ACanvas: TCanvas; ARect: TRect);
1519 begin
1520 Draw(TCanvasDrawer.Create(ACanvas), ARect);
1521 end;
1522
1523 procedure TChart.PrepareAxis(ADrawer: IChartDrawer);
1524 var
1525 axisMargin: TChartAxisMargins;
1526 aa: TChartAxisAlignment;
1527 cr: TRect;
1528 tries: Integer;
1529 prevExt: TDoubleRect;
1530 axis: TChartAxis;
1531 scDepth: Integer;
1532 scSeriesMargins: TRect;
1533 scChartMargins: TRect;
1534 scMinDataSpace: Integer;
1535 begin
1536 scDepth := ADrawer.Scale(Depth);
1537 scSeriesMargins := GetMargins(ADrawer);
1538 scChartMargins.Left := ADrawer.Scale(Margins.Left);
1539 scChartMargins.Right := ADrawer.Scale(Margins.Right);
1540 scChartMargins.Top := ADrawer.Scale(Margins.Top);
1541 scChartMargins.Bottom := ADrawer.Scale(Margins.Bottom);
1542 scMinDataSpace := ADrawer.Scale(FMinDataSpace);
1543
1544 if not AxisVisible then begin
1545 FClipRect.Left += scDepth;
1546 FClipRect.Bottom -= scDepth;
1547 CalculateTransformationCoeffs(scSeriesMargins, scChartMargins, scMinDataSpace);
1548 exit;
1549 end;
1550
1551 AxisList.PrepareGroups;
1552 for axis in AxisList do
1553 axis.PrepareHelper(ADrawer, Self, @FClipRect, scDepth);
1554
1555 // There is a cyclic dependency: extent -> visible marks -> margins.
1556 // We recalculate them iteratively hoping that the process converges.
1557 CalculateTransformationCoeffs(scSeriesMargins, scChartMargins, scMinDataSpace);
1558 cr := FClipRect;
1559 for tries := 1 to 10 do begin
1560 axisMargin := AxisList.Measure(CurrentExtent, FClipRect, scDepth);
1561 axisMargin[calLeft] := Max(axisMargin[calLeft], scDepth);
1562 axisMargin[calBottom] := Max(axisMargin[calBottom], scDepth);
1563 FClipRect := cr;
1564 for aa := Low(aa) to High(aa) do
1565 SideByAlignment(FClipRect, aa, -axisMargin[aa]);
1566 prevExt := FCurrentExtent;
1567 FCurrentExtent := FLogicalExtent;
1568 CalculateTransformationCoeffs(scSeriesMargins, scChartMargins, scMinDataSpace);
1569 if prevExt = FCurrentExtent then break;
1570 prevExt := FCurrentExtent;
1571 end;
1572
1573 AxisList.Prepare(FClipRect);
1574 end;
1575
1576 procedure TChart.Prepare;
1577 var
1578 a: TChartAxis;
1579 s: TBasicChartSeries;
1580 begin
1581 FScalingValid := False;
1582 FMultiPassScalingNeeded := False;
1583
1584 for a in AxisList do
1585 if a.Transformations <> nil then
1586 a.Transformations.SetChart(Self);
1587 for s in Series do
1588 s.BeforeDraw;
1589
1590 if not FIsZoomed then
1591 FLogicalExtent := GetFullExtent;
1592 FCurrentExtent := FLogicalExtent;
1593 end;
1594
TChart.PrepareLegendnull1595 function TChart.PrepareLegend(
1596 ADrawer: IChartDrawer; var AClipRect: TRect): TChartLegendDrawingData;
1597 begin
1598 Result.FDrawer := ADrawer;
1599 Result.FItems := GetLegendItems;
1600 try
1601 Legend.SortItemsByOrder(Result.FItems);
1602 Legend.AddGroups(Result.FItems);
1603 Legend.Prepare(Result, AClipRect);
1604 except
1605 FreeAndNil(Result.FItems);
1606 raise;
1607 end;
1608 end;
1609
1610 procedure TChart.RemoveSeries(ASeries: TBasicChartSeries);
1611 begin
1612 DeleteSeries(ASeries);
1613 end;
1614
1615 procedure TChart.SaveToBitmapFile(const AFileName: String);
1616 begin
1617 SaveToFile(TBitmap, AFileName);
1618 end;
1619
1620 procedure TChart.SaveToFile(AClass: TRasterImageClass; AFileName: String);
1621 begin
1622 with SaveToImage(AClass) do
1623 try
1624 SaveToFile(AFileName);
1625 finally
1626 Free;
1627 end;
1628 end;
1629
TChart.SaveToImagenull1630 function TChart.SaveToImage(AClass: TRasterImageClass): TRasterImage;
1631 begin
1632 Result := AClass.Create;
1633 try
1634 Result.Width := Width;
1635 Result.Height := Height;
1636 PaintOnCanvas(Result.Canvas, Rect(0, 0, Width, Height));
1637 except
1638 Result.Free;
1639 raise;
1640 end;
1641 end;
1642
1643 procedure TChart.SetAntialiasingMode(AValue: TChartAntialiasingMode);
1644 begin
1645 if FAntialiasingMode = AValue then exit;
1646 FAntialiasingMode := AValue;
1647 StyleChanged(Self);
1648 end;
1649
1650 procedure TChart.SetAxisByAlign(AAlign: TChartAxisAlignment; AValue: TChartAxis);
1651 begin
1652 FAxisList.SetAxisByAlign(AAlign, AValue);
1653 StyleChanged(AValue);
1654 end;
1655
1656 procedure TChart.SetAxisList(AValue: TChartAxisList);
1657 begin
1658 FAxisList.Assign(AValue);
1659 StyleChanged(Self);
1660 end;
1661
1662 procedure TChart.SetAxisVisible(Value: Boolean);
1663 begin
1664 FAxisVisible := Value;
1665 StyleChanged(Self);
1666 end;
1667
1668 procedure TChart.SetBackColor(AValue: TColor);
1669 begin
1670 FBackColor:= AValue;
1671 StyleChanged(Self);
1672 end;
1673
1674 procedure TChart.SetBiDiMode(AValue: TBiDiMode);
1675 begin
1676 if AValue = BidiMode then
1677 exit;
1678 inherited SetBiDiMode(AValue);
1679 if not (csLoading in ComponentState) then begin
1680 AxisList.UpdateBidiMode;
1681 Legend.UpdateBidiMode;
1682 Title.UpdateBidiMode;
1683 Foot.UpdateBidiMode;
1684 Series.UpdateBiDiMode;
1685 end;
1686 end;
1687
1688 procedure TChart.SetChildOrder(Child: TComponent; Order: Integer);
1689 var
1690 i: Integer;
1691 begin
1692 i := Series.FList.IndexOf(Child);
1693 if i >= 0 then
1694 Series.FList.Move(i, Order);
1695 end;
1696
1697 procedure TChart.SetDepth(AValue: TChartDistance);
1698 begin
1699 if FDepth = AValue then exit;
1700 FDepth := AValue;
1701 StyleChanged(Self);
1702 end;
1703
1704 procedure TChart.SetExpandPercentage(AValue: Integer);
1705 begin
1706 if FExpandPercentage = AValue then exit;
1707 FExpandPercentage := AValue;
1708 StyleChanged(Self);
1709 end;
1710
1711 procedure TChart.SetExtent(AValue: TChartExtent);
1712 begin
1713 FExtent.Assign(AValue);
1714 StyleChanged(Self);
1715 end;
1716
1717 procedure TChart.SetExtentSizeLimit(AValue: TChartExtent);
1718 begin
1719 if FExtentSizeLimit = AValue then exit;
1720 FExtentSizeLimit.Assign(AValue);
1721 StyleChanged(Self);
1722 end;
1723
1724 procedure TChart.SetFoot(Value: TChartTitle);
1725 begin
1726 FFoot.Assign(Value);
1727 StyleChanged(Self);
1728 end;
1729
1730 procedure TChart.SetFrame(Value: TChartPen);
1731 begin
1732 FFrame.Assign(Value);
1733 StyleChanged(Self);
1734 end;
1735
1736 procedure TChart.SetGUIConnector(AValue: TChartGUIConnector);
1737 begin
1738 if FGUIConnector = AValue then exit;
1739 if FGUIConnector <> nil then
1740 RemoveFreeNotification(FGUIConnector);
1741 if FGUIConnectorListener.IsListening then
1742 FGUIConnector.Broadcaster.Unsubscribe(FGUIConnectorListener);
1743 FGUIConnector := AValue;
1744 if FGUIConnector <> nil then begin
1745 FGUIConnector.Broadcaster.Subscribe(FGUIConnectorListener);
1746 FreeNotification(FGUIConnector);
1747 end;
1748 EffectiveGUIConnector.CreateDrawer(FConnectorData);
1749 StyleChanged(Self);
1750 end;
1751
1752 procedure TChart.SetLegend(Value: TChartLegend);
1753 begin
1754 FLegend.Assign(Value);
1755 StyleChanged(Self);
1756 end;
1757
1758 procedure TChart.SetLogicalExtent(AValue: TDoubleRect);
1759 var
1760 AllowChange: Boolean;
1761 w, h: Double;
1762 begin
1763 if FSetLogicalExtentCounter <> 0 then
1764 raise EChartError.CreateFmt(SNestedSetLogicalExtentCall, [NameOrClassName(Self), 'ALogicalExtent']);
1765
1766 if Assigned(OnExtentValidate) then begin
1767 AllowChange := true;
1768 Inc(FSetLogicalExtentCounter);
1769 try
1770 OnExtentValidate(Self, AValue, AllowChange);
1771 finally
1772 Dec(FSetLogicalExtentCounter);
1773 end;
1774 if not AllowChange then exit;
1775 end;
1776 if FLogicalExtent = AValue then exit;
1777 w := Abs(AValue.a.X - AValue.b.X);
1778 h := Abs(AValue.a.Y - AValue.b.Y);
1779 with ExtentSizeLimit do
1780 if
1781 UseXMin and (w < XMin) or UseXMax and (w > XMax) or
1782 UseYMin and (h < YMin) or UseYMax and (h > YMax)
1783 then
1784 exit;
1785 FLogicalExtent := AValue;
1786 FIsZoomed := true;
1787 StyleChanged(Self);
1788 end;
1789
1790 procedure TChart.SetMargins(AValue: TChartMargins);
1791 begin
1792 FMargins.Assign(AValue);
1793 StyleChanged(Self);
1794 end;
1795
1796 procedure TChart.SetMarginsExternal(AValue: TChartMargins);
1797 begin
1798 if FMarginsExternal = AValue then exit;
1799 FMarginsExternal.Assign(AValue);
1800 StyleChanged(Self);
1801 end;
1802
1803 procedure TChart.SetMinDataSpace(const AValue: Integer);
1804 begin
1805 if FMinDataSpace = abs(AValue) then exit;
1806 FMinDataSpace := abs(AValue);
1807 StyleChanged(Self);
1808 end;
1809
1810 procedure TChart.SetName(const AValue: TComponentName);
1811 var
1812 oldName: String;
1813 begin
1814 if Name = AValue then exit;
1815 oldName := Name;
1816 inherited SetName(AValue);
1817 if csDesigning in ComponentState then
1818 Series.List.ChangeNamePrefix(oldName, AValue);
1819 end;
1820
1821 procedure TChart.SetOnAfterDraw(AValue: TChartDrawEvent);
1822 begin
1823 if TMethod(FOnAfterDraw) = TMethod(AValue) then exit;
1824 FOnAfterDraw := AValue;
1825 StyleChanged(Self);
1826 end;
1827
1828 procedure TChart.SetOnAfterCustomDrawBackground(AValue: TChartAfterCustomDrawEvent);
1829 begin
1830 if TMethod(FOnAfterCustomDrawBackground) = TMethod(AValue) then exit;
1831 FOnAfterCustomDrawBackground := AValue;
1832 StyleChanged(Self);
1833 end;
1834
1835 procedure TChart.SetOnAfterCustomDrawBackWall(AValue: TChartAfterCustomDrawEvent);
1836 begin
1837 if TMethod(FOnAfterCustomDrawBackWall) = TMethod(AValue) then exit;
1838 FOnAfterCustomDrawBackWall := AValue;
1839 StyleChanged(Self);
1840 end;
1841
1842 procedure TChart.SetOnAfterDrawBackground(AValue: TChartAfterDrawEvent);
1843 begin
1844 if TMethod(FOnAfterDrawBackground) = TMethod(AValue) then exit;
1845 FOnAfterDrawBackground := AValue;
1846 StyleChanged(Self);
1847 end;
1848
1849 procedure TChart.SetOnAfterDrawBackWall(AValue: TChartAfterDrawEvent);
1850 begin
1851 if TMethod(FOnAfterDrawBackWall) = TMethod(AValue) then exit;
1852 FOnAfterDrawBackWall := AValue;
1853 StyleChanged(Self);
1854 end;
1855
1856 procedure TChart.SetOnBeforeCustomDrawBackground(AValue: TChartBeforeCustomDrawEvent);
1857 begin
1858 if TMethod(FOnBeforeCustomDrawBackground) = TMethod(AValue) then exit;
1859 FOnBeforeCustomDrawBackground := AValue;
1860 StyleChanged(Self);
1861 end;
1862
1863 procedure TChart.SetOnBeforeCustomDrawBackWall(AValue: TChartBeforeCustomDrawEvent);
1864 begin
1865 if TMethod(FOnBeforeCustomDrawBackWall) = TMethod(AValue) then exit;
1866 FOnBeforeCustomDrawBackWall := AValue;
1867 StyleChanged(Self);
1868 end;
1869
1870 procedure TChart.SetOnBeforeDrawBackground(AValue: TChartBeforeDrawEvent);
1871 begin
1872 if TMethod(FOnBeforeDrawBackground) = TMethod(AValue) then exit;
1873 FOnBeforeDrawBackground := AValue;
1874 StyleChanged(Self);
1875 end;
1876
1877 procedure TChart.SetOnBeforeDrawBackWall(AValue: TChartBeforeDrawEvent);
1878 begin
1879 if TMethod(FOnBeforeDrawBackWall) = TMethod(AValue) then exit;
1880 FOnBeforeDrawBackWall := AValue;
1881 StyleChanged(Self);
1882 end;
1883
1884 procedure TChart.SetOnChartPaint(AValue: TChartPaintEvent);
1885 begin
1886 if TMethod(FOnChartPaint) = TMethod(AValue) then exit;
1887 FOnChartPaint := AValue;
1888 StyleChanged(Self);
1889 end;
1890
1891 procedure TChart.SetOnDrawLegend(AValue: TChartDrawLegendEvent);
1892 begin
1893 if TMethod(FOnDrawLegend) = TMethod(AValue) then exit;
1894 FOnDrawLegend := AValue;
1895 StyleChanged(self);
1896 end;
1897
1898 procedure TChart.SetProportional(AValue: Boolean);
1899 begin
1900 if FProportional = AValue then exit;
1901 FProportional := AValue;
1902 StyleChanged(Self);
1903 end;
1904
1905 procedure TChart.SetRenderingParams(AValue: TChartRenderingParams);
1906 begin
1907 FScale := AValue.FScale;
1908 FOffset := AValue.FOffset;
1909 FClipRect := AValue.FClipRect;
1910 FLogicalExtent := AValue.FLogicalExtent;
1911 FPrevLogicalExtent := AValue.FPrevLogicalExtent;
1912 FIsZoomed := AValue.FIsZoomed;
1913 end;
1914
1915 procedure TChart.SetTitle(Value: TChartTitle);
1916 begin
1917 FTitle.Assign(Value);
1918 StyleChanged(Self);
1919 end;
1920
1921 procedure TChart.SetToolset(AValue: TBasicChartToolset);
1922 begin
1923 if FToolset = AValue then exit;
1924 if FToolset <> nil then
1925 RemoveFreeNotification(FToolset);
1926 FToolset := AValue;
1927 FActiveToolIndex := -1;
1928 if FToolset <> nil then
1929 FreeNotification(FToolset);
1930 end;
1931
1932 procedure TChart.StyleChanged(Sender: TObject);
1933 begin
1934 if FDisableRedrawingCounter > 0 then exit;
1935 if Sender is TChartExtent then
1936 ZoomFull;
1937 Invalidate;
1938 Broadcaster.Broadcast(Sender);
1939 end;
1940
1941 procedure TChart.UnlockCliprect;
1942 begin
1943 dec(FClipRectLock);
1944 if FClipRectLock = 0 then Invalidate;
1945 end;
1946
UsesBuiltinToolsetnull1947 function TChart.UsesBuiltinToolset: Boolean;
1948 begin
1949 Result := (GetToolset = FBuiltinToolset);
1950 end;
1951
1952 procedure TChart.VisitSources(
1953 AVisitor: TChartOnSourceVisitor; AAxis: TChartAxis; var AData);
1954 var
1955 s: TBasicChartSeries;
1956 begin
1957 for s in Series do
1958 if s.Active then
1959 s.VisitSources(AVisitor, AAxis, AData);
1960 end;
1961
TChart.XGraphToImagenull1962 function TChart.XGraphToImage(AX: Double): Integer;
1963 begin
1964 {$IFDEF CHECK_VALID_SCALING}
1965 if not FScalingValid then
1966 raise EChartError.CreateFmt(SScalingNotInitialized, [NameOrClassName(self), 'XGraphToImage']);
1967 {$ENDIF}
1968 Result := ImgRoundChecked(FScale.X * AX + FOffset.X) + FOffsetInt.X;
1969 end;
1970
XImageToGraphnull1971 function TChart.XImageToGraph(AX: Integer): Double;
1972 begin
1973 {$IFDEF CHECK_VALID_SCALING}
1974 if not FScalingValid then
1975 raise EChartError.CreateFmt(SScalingNotInitialized, [NameOrClassName(self), 'XImageToGraph']);
1976 {$ENDIF}
1977 Result := ((AX - FOffsetInt.X) - FOffset.X) / FScale.X;
1978 end;
1979
TChart.YGraphToImagenull1980 function TChart.YGraphToImage(AY: Double): Integer;
1981 begin
1982 {$IFDEF CHECK_VALID_SCALING}
1983 if not FScalingValid then
1984 raise EChartError.CreateFmt(SScalingNotInitialized, [NameOrClassName(self), 'YGraphToImage']);
1985 {$ENDIF}
1986 Result := ImgRoundChecked(FScale.Y * AY + FOffset.Y) + FOffsetInt.Y;
1987 end;
1988
TChart.YImageToGraphnull1989 function TChart.YImageToGraph(AY: Integer): Double;
1990 begin
1991 {$IFDEF CHECK_VALID_SCALING}
1992 if not FScalingValid then
1993 raise EChartError.CreateFmt(SScalingNotInitialized, [NameOrClassName(self), 'YImageToGraph']);
1994 {$ENDIF}
1995 Result := ((AY - FOffsetInt.Y) - FOffset.Y) / FScale.Y;
1996 end;
1997
1998 procedure TChart.RequestMultiPassScaling;
1999 begin
2000 FMultiPassScalingNeeded := True;
2001 end;
2002
2003 procedure TChart.ZoomFull(AImmediateRecalc: Boolean);
2004 begin
2005 if AImmediateRecalc then
2006 FLogicalExtent := GetFullExtent;
2007 if not FIsZoomed then exit;
2008 FIsZoomed := false;
2009 Invalidate;
2010 end;
2011
2012 { TBasicChartSeries }
2013
2014 procedure TBasicChartSeries.AfterDraw;
2015 begin
2016 // empty
2017 end;
2018
2019 procedure TBasicChartSeries.Assign(Source: TPersistent);
2020 begin
2021 if Source is TBasicChartSeries then
2022 with TBasicChartSeries(Source) do begin
2023 Self.FActive := FActive;
2024 Self.FDepth := FDepth;
2025 Self.FZPosition := FZPosition;
2026 end;
2027 end;
2028
TBasicChartSeries.AxisToGraphXnull2029 function TBasicChartSeries.AxisToGraphX(AX: Double): Double;
2030 begin
2031 Result := AX;
2032 end;
2033
TBasicChartSeries.AxisToGraphYnull2034 function TBasicChartSeries.AxisToGraphY(AY: Double): Double;
2035 begin
2036 Result := AY;
2037 end;
2038
2039 procedure TBasicChartSeries.BeforeDraw;
2040 begin
2041 // empty
2042 end;
2043
2044 destructor TBasicChartSeries.Destroy;
2045 begin
2046 if FChart <> nil then
2047 FChart.DeleteSeries(Self);
2048 inherited;
2049 end;
2050
GraphToAxisXnull2051 function TBasicChartSeries.GraphToAxisX(AX: Double): Double;
2052 begin
2053 Result := AX;
2054 end;
2055
GraphToAxisYnull2056 function TBasicChartSeries.GraphToAxisY(AY: Double): Double;
2057 begin
2058 Result := AY;
2059 end;
2060
2061 procedure TBasicChartSeries.MovePoint(
2062 var AIndex: Integer; const ANewPos: TDoublePoint);
2063 begin
2064 Unused(AIndex, ANewPos)
2065 end;
2066
2067 procedure TBasicChartSeries.MovePoint(
2068 var AIndex: Integer; const ANewPos: TPoint);
2069 begin
2070 MovePoint(AIndex, FChart.ImageToGraph(ANewPos));
2071 end;
2072
2073 procedure TBasicChartSeries.MovePointEx(
2074 var AIndex: Integer; AXIndex, AYIndex: Integer; const ANewPos: TDoublePoint);
2075 begin
2076 Unused(AXIndex, AYIndex);
2077 MovePoint(AIndex, ANewPos);
2078 end;
2079
RequestValidChartScalingnull2080 function TBasicChartSeries.RequestValidChartScaling: Boolean;
2081 begin
2082 Result := false;
2083 if not Assigned(FChart) then exit;
2084
2085 // We request a valid scaling from FChart. Scaling is not initialized during
2086 // the first phase of scaling calculation, so we request more phases. If we
2087 // are already beyond the scaling calculation loop, our request will be just
2088 // ignored.
2089 FChart.RequestMultiPassScaling;
2090
2091 Result := FChart.ScalingValid;
2092 end;
2093
2094 procedure TBasicChartSeries.UpdateBiDiMode;
2095 begin
2096 // normally nothing to do. Override, e.g., to flip arrows
2097 end;
2098
2099 procedure TBasicChartSeries.UpdateMargins(
2100 ADrawer: IChartDrawer; var AMargins: TRect);
2101 begin
2102 Unused(ADrawer, AMargins);
2103 end;
2104
2105 procedure TBasicChartSeries.VisitSources(
2106 AVisitor: TChartOnSourceVisitor; AAxis: TChartAxis; var AData);
2107 begin
2108 Unused(AVisitor, AAxis);
2109 Unused(AData);
2110 end;
2111
2112 { TChartSeriesList }
2113
2114 procedure TChartSeriesList.Clear;
2115 var
2116 i: Integer;
2117 begin
2118 if FList.Count > 0 then
2119 Items[0].FChart.StyleChanged(Items[0].FChart);
2120 for i := 0 to FList.Count - 1 do begin
2121 Items[i].FChart := nil;
2122 Items[i].Free;
2123 end;
2124 FList.Clear;
2125 end;
2126
TChartSeriesList.Countnull2127 function TChartSeriesList.Count: Integer;
2128 begin
2129 Result := FList.Count;
2130 end;
2131
2132 constructor TChartSeriesList.Create;
2133 begin
2134 FList := TIndexedComponentList.Create;
2135 end;
2136
2137 destructor TChartSeriesList.Destroy;
2138 begin
2139 Clear;
2140 FreeAndNil(FList);
2141 inherited;
2142 end;
2143
GetEnumeratornull2144 function TChartSeriesList.GetEnumerator: TBasicChartSeriesEnumerator;
2145 begin
2146 Result := TBasicChartSeriesEnumerator.Create(FList);
2147 end;
2148
GetItemnull2149 function TChartSeriesList.GetItem(AIndex: Integer): TBasicChartSeries;
2150 begin
2151 Result := TBasicChartSeries(FList.Items[AIndex]);
2152 end;
2153
2154 procedure TChartSeriesList.UpdateBiDiMode;
2155 var
2156 s: TBasicChartseries;
2157 begin
2158 for s in self do
2159 s.UpdateBiDiMode;
2160 end;
2161
2162 { TBasicChartTool }
2163
2164 procedure TBasicChartTool.Activate;
2165 begin
2166 FChart.FActiveToolIndex := Index;
2167 FChart.MouseCapture := true;
2168 FChart.FDisablePopupMenu := false;
2169 FStartMousePos := Mouse.CursorPos;
2170 end;
2171
2172 procedure TBasicChartTool.Deactivate;
2173 begin
2174 FChart.MouseCapture := false;
2175 FChart.FActiveToolIndex := -1;
2176 if PopupMenuConflict then
2177 FChart.FDisablePopupMenu := true;
2178 end;
2179
PopupMenuConflictnull2180 function TBasicChartTool.PopupMenuConflict: Boolean;
2181 begin
2182 Result := false;
2183 end;
2184
2185 procedure SkipObsoleteChartProperties;
2186 const
2187 MIRRORX_NOTE = 'Obsolete, use BottomAxis.Invert instead';
2188 AXIS_COLOR_NOTE = 'Obsolete, use Axis.TickColor instead';
2189 ANGLE_NOTE = 'Obsolete, use Font.Orientation instead';
2190 NOTE = 'Obsolete, use Extent instead';
2191 NAMES: array [1..4] of String = (
2192 'XGraph', 'YGraph', 'AutoUpdateX', 'AutoUpdateY');
2193 var
2194 i: Integer;
2195 begin
2196 RegisterPropertyToSkip(TChart, 'MirrorX', MIRRORX_NOTE, '');
2197 RegisterPropertyToSkip(TChart, 'AxisColor', AXIS_COLOR_NOTE, '');
2198 RegisterPropertyToSkip(TChartAxisTitle, 'Angle', ANGLE_NOTE, '');
2199 for i := 1 to High(NAMES) do begin
2200 RegisterPropertyToSkip(TChart, NAMES[i] + 'Min', NOTE, '');
2201 RegisterPropertyToSkip(TChart, NAMES[i] + 'Max', NOTE, '');
2202 end;
2203 end;
2204
2205 initialization
2206 SkipObsoleteChartProperties;
2207 SeriesClassRegistry := TClassRegistry.Create;
2208 ShowMessageProc := @ShowMessage;
2209
2210 finalization
2211 FreeAndNil(SeriesClassRegistry);
2212
2213 end.
2214