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