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

« back to all changes in this revision

Viewing changes to components/tachart/tagraph.pas

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

Show diffs side-by-side

added added

removed removed

Lines of Context:
28
28
interface
29
29
 
30
30
uses
31
 
  LCLIntF, LCLType, LResources,
32
 
  SysUtils, Classes, Controls, Graphics, Dialogs,
33
 
  TAChartUtils, TATypes, TALegend, TAChartAxis;
 
31
  Graphics, Classes, Controls, LCLType, SysUtils,
 
32
  TAChartAxis, TAChartAxisUtils, TAChartUtils, TADrawUtils, TALegend, TATypes;
34
33
 
35
34
type
36
35
  TChart = class;
48
47
    FActive: Boolean;
49
48
    FChart: TChart;
50
49
    FDepth: TChartDistance;
51
 
    FTitle: String;
52
50
    FZPosition: TChartDistance;
53
51
 
54
52
    procedure AfterAdd; virtual; abstract;
55
53
    procedure AfterDraw; virtual;
56
54
    procedure BeforeDraw; virtual;
57
 
    // Set series bounds in axis coordinates.
58
 
    // Some or all bounds may be left unset, in which case they will be ignored.
59
 
    procedure GetBounds(var ABounds: TDoubleRect); virtual; abstract;
60
55
    procedure GetGraphBounds(var ABounds: TDoubleRect); virtual; abstract;
61
56
    procedure GetLegendItemsBasic(AItems: TChartLegendItems); virtual; abstract;
62
57
    function GetShowInLegend: Boolean; virtual; abstract;
63
58
    procedure SetActive(AValue: Boolean); virtual; abstract;
64
59
    procedure SetDepth(AValue: TChartDistance); virtual; abstract;
65
 
    procedure SetTitle(const AValue: String); virtual; abstract;
 
60
    procedure SetShowInLegend(AValue: Boolean); virtual; abstract;
66
61
    procedure SetZPosition(AValue: TChartDistance); virtual; abstract;
67
 
    procedure UpdateMargins(ACanvas: TCanvas; var AMargins: TRect); virtual;
 
62
    procedure UpdateMargins(ADrawer: IChartDrawer; var AMargins: TRect); virtual;
68
63
    procedure VisitSources(
69
64
      AVisitor: TChartOnSourceVisitor; AAxis: TChartAxis; var AData); virtual;
70
65
 
71
 
  protected
 
66
  public
72
67
    function AxisToGraphX(AX: Double): Double; virtual;
73
68
    function AxisToGraphY(AY: Double): Double; virtual;
74
69
    function GraphToAxisX(AX: Double): Double; virtual;
75
70
    function GraphToAxisY(AY: Double): Double; virtual;
76
71
 
77
72
  public
 
73
    procedure Assign(Source: TPersistent); override;
78
74
    destructor Destroy; override;
79
75
 
80
76
  public
81
 
    procedure Draw(ACanvas: TCanvas); virtual; abstract;
 
77
    procedure Draw(ADrawer: IChartDrawer); virtual; abstract;
82
78
    function IsEmpty: Boolean; virtual; abstract;
83
 
    procedure MovePoint(var AIndex: Integer; const ANewPos: TPoint); virtual;
 
79
    procedure MovePoint(var AIndex: Integer; const ANewPos: TPoint); overload; inline;
 
80
    procedure MovePoint(var AIndex: Integer; const ANewPos: TDoublePoint); overload; virtual;
84
81
 
85
82
    property Active: Boolean read FActive write SetActive default true;
86
83
    property Depth: TChartDistance read FDepth write SetDepth default 0;
87
84
    property ParentChart: TChart read FChart;
88
 
    property Title: String read FTitle write SetTitle;
89
85
    property ZPosition: TChartDistance read FZPosition write SetZPosition default 0;
90
86
  end;
91
87
 
92
88
  TSeriesClass = class of TBasicChartSeries;
93
89
 
94
 
  TChartToolEvent = procedure (AChart: TChart; AX, AY: Integer) of object;
95
 
 
96
90
  { TBasicСhartTool }
97
91
 
98
92
  TBasicChartTool = class(TIndexedComponent)
101
95
 
102
96
    procedure Activate; virtual;
103
97
    procedure Deactivate; virtual;
 
98
  public
 
99
    property Chart: TChart read FChart;
104
100
  end;
105
101
 
106
 
  TChartToolEventId = (evidMouseDown, evidMouseMove, evidMouseUp);
 
102
  TChartToolEventId = (
 
103
    evidKeyDown, evidKeyUp, evidMouseDown, evidMouseMove, evidMouseUp,
 
104
    evidMouseWheelDown, evidMouseWheelUp);
107
105
 
108
106
  { TBasicChartToolset }
109
107
 
110
108
  TBasicChartToolset = class(TComponent)
111
 
  protected
 
109
  public
112
110
    function Dispatch(
113
111
      AChart: TChart; AEventId: TChartToolEventId;
114
112
      AShift: TShiftState; APoint: TPoint): Boolean; virtual; abstract; overload;
 
113
      procedure Draw(AChart: TChart; ADrawer: IChartDrawer); virtual; abstract;
 
114
  end;
 
115
 
 
116
  TBasicChartSeriesEnumerator = class(TFPListEnumerator)
 
117
  public
 
118
    function GetCurrent: TBasicChartSeries;
 
119
    property Current: TBasicChartSeries read GetCurrent;
115
120
  end;
116
121
 
117
122
  { TChartSeriesList }
118
123
 
119
124
  TChartSeriesList = class(TPersistent)
120
125
  private
121
 
    FList: TFPList;
 
126
    FList: TIndexedComponentList;
122
127
    function GetItem(AIndex: Integer): TBasicChartSeries;
123
128
  public
124
129
    constructor Create;
126
131
  public
127
132
    procedure Clear;
128
133
    function Count: Integer;
 
134
    function GetEnumerator: TBasicChartSeriesEnumerator;
129
135
  public
130
136
    property Items[AIndex: Integer]: TBasicChartSeries read GetItem; default;
131
 
    property List: TFPList read FList;
 
137
    property List: TIndexedComponentList read FList;
 
138
  end;
 
139
 
 
140
  TChartAfterDrawEvent = procedure (
 
141
    ASender: TChart; ACanvas: TCanvas; const ARect: TRect) of object;
 
142
  TChartBeforeDrawEvent = procedure (
 
143
    ASender: TChart; ACanvas: TCanvas; const ARect: TRect;
 
144
    var ADoDefaultDrawing: Boolean) of object;
 
145
  TChartEvent = procedure (ASender: TChart) of object;
 
146
  TChartPaintEvent = procedure (
 
147
    ASender: TChart; const ARect: TRect;
 
148
    var ADoDefaultDrawing: Boolean) of object;
 
149
 
 
150
  TChartRenderingParams = record
 
151
    FClipRect: TRect;
 
152
    FIsZoomed: Boolean;
 
153
    FLogicalExtent, FPrevLogicalExtent: TDoubleRect;
 
154
    FScale, FOffset: TDoublePoint;
132
155
  end;
133
156
 
134
157
  { TChart }
135
158
 
136
159
  TChart = class(TCustomChart, ICoordTransformer)
137
 
  private // Property fields
 
160
  strict private // Property fields
138
161
    FAllowZoom: Boolean;
 
162
    FAntialiasingMode: TChartAntialiasingMode;
139
163
    FAxisList: TChartAxisList;
140
164
    FAxisVisible: Boolean;
141
165
    FBackColor: TColor;
142
166
    FDepth: TChartDistance;
143
167
    FExpandPercentage: Integer;
144
168
    FExtent: TChartExtent;
 
169
    FExtentSizeLimit: TChartExtent;
145
170
    FFoot: TChartTitle;
146
171
    FFrame: TChartPen;
147
172
    FGraphBrush: TBrush;
148
173
    FLegend: TChartLegend;
149
174
    FLogicalExtent: TDoubleRect;
150
175
    FMargins: TChartMargins;
 
176
    FMarginsExternal: TChartMargins;
 
177
    FOnAfterDrawBackground: TChartAfterDrawEvent;
 
178
    FOnAfterDrawBackWall: TChartAfterDrawEvent;
 
179
    FOnBeforeDrawBackground: TChartBeforeDrawEvent;
 
180
    FOnBeforeDrawBackWall: TChartBeforeDrawEvent;
 
181
    FOnChartPaint: TChartPaintEvent;
151
182
    FOnDrawReticule: TDrawReticuleEvent;
 
183
    FProportional: Boolean;
152
184
    FSeries: TChartSeriesList;
153
185
    FTitle: TChartTitle;
154
186
    FToolset: TBasicChartToolset;
155
187
 
 
188
    function ClipRectWithoutFrame(AZPosition: TChartDistance): TRect;
156
189
  private
157
190
    FActiveToolIndex: Integer;
158
191
    FBroadcaster: TBroadcaster;
159
192
    FBuiltinToolset: TBasicChartToolset;
160
193
    FClipRect: TRect;
161
194
    FCurrentExtent: TDoubleRect;
 
195
    FDisableRedrawingCounter: Integer;
 
196
    FDrawer: IChartDrawer;
 
197
    FExtentBroadcaster: TBroadcaster;
162
198
    FIsZoomed: Boolean;
163
199
    FOffset: TDoublePoint;   // Coordinates transformation
164
 
    FProportional: Boolean;
 
200
    FOnAfterPaint: TChartEvent;
 
201
    FOnExtentChanged: TChartEvent;
 
202
    FPrevLogicalExtent: TDoubleRect;
165
203
    FReticuleMode: TReticuleMode;
166
204
    FReticulePos: TPoint;
167
205
    FScale: TDoublePoint;    // Coordinates transformation
168
206
 
169
207
    procedure CalculateTransformationCoeffs(const AMargin: TRect);
170
 
    procedure DrawReticule(ACanvas: TCanvas);
171
 
    function GetAxis(AIndex: integer): TChartAxis; inline;
 
208
    procedure DrawReticule(ADrawer: IChartDrawer);
 
209
    procedure FindComponentClass(
 
210
      AReader: TReader; const AClassName: String; var AClass: TComponentClass);
 
211
    function GetAxis(AIndex: Integer): TChartAxis;
172
212
    function GetChartHeight: Integer;
173
213
    function GetChartWidth: Integer;
174
 
    function GetMargins(ACanvas: TCanvas): TRect;
 
214
    function GetMargins(ADrawer: IChartDrawer): TRect;
 
215
    function GetRenderingParams: TChartRenderingParams;
175
216
    function GetSeriesCount: Integer;
176
217
    function GetToolset: TBasicChartToolset;
177
218
    procedure HideReticule;
178
219
 
 
220
    procedure SetAntialiasingMode(AValue: TChartAntialiasingMode);
179
221
    procedure SetAxis(AIndex: Integer; AValue: TChartAxis);
180
222
    procedure SetAxisList(AValue: TChartAxisList);
181
223
    procedure SetAxisVisible(Value: Boolean);
182
 
    procedure SetBackColor(const AValue: TColor);
 
224
    procedure SetBackColor(AValue: TColor);
183
225
    procedure SetDepth(AValue: TChartDistance);
184
226
    procedure SetExpandPercentage(AValue: Integer);
185
 
    procedure SetExtent(const AValue: TChartExtent);
 
227
    procedure SetExtent(AValue: TChartExtent);
 
228
    procedure SetExtentSizeLimit(AValue: TChartExtent);
186
229
    procedure SetFoot(Value: TChartTitle);
187
230
    procedure SetFrame(Value: TChartPen);
188
231
    procedure SetGraphBrush(Value: TBrush);
189
232
    procedure SetLegend(Value: TChartLegend);
190
233
    procedure SetLogicalExtent(const AValue: TDoubleRect);
191
234
    procedure SetMargins(AValue: TChartMargins);
 
235
    procedure SetMarginsExternal(AValue: TChartMargins);
 
236
    procedure SetOnAfterDrawBackground(AValue: TChartAfterDrawEvent);
 
237
    procedure SetOnAfterDrawBackWall(AValue: TChartAfterDrawEvent);
 
238
    procedure SetOnBeforeDrawBackground(AValue: TChartBeforeDrawEvent);
 
239
    procedure SetOnBeforeDrawBackWall(AValue: TChartBeforeDrawEvent);
 
240
    procedure SetOnChartPaint(AValue: TChartPaintEvent);
 
241
    procedure SetOnDrawReticule(AValue: TDrawReticuleEvent);
192
242
    procedure SetProportional(AValue: Boolean);
193
 
    procedure SetReticuleMode(const AValue: TReticuleMode);
 
243
    procedure SetRenderingParams(AValue: TChartRenderingParams);
 
244
    procedure SetReticuleMode(AValue: TReticuleMode);
194
245
    procedure SetReticulePos(const AValue: TPoint);
195
246
    procedure SetTitle(Value: TChartTitle);
196
247
    procedure SetToolset(AValue: TBasicChartToolset);
197
248
    procedure VisitSources(
198
249
      AVisitor: TChartOnSourceVisitor; AAxis: TChartAxis; var AData);
199
250
  protected
200
 
    procedure Clean(ACanvas: TCanvas; ARect: TRect);
201
 
    procedure DisplaySeries(ACanvas: TCanvas);
202
 
    procedure DrawBackground(const ACanvas: TCanvas);
203
 
    procedure DrawTitleFoot(ACanvas: TCanvas);
 
251
    function DoMouseWheel(
 
252
      AShift: TShiftState; AWheelDelta: Integer;
 
253
      AMousePos: TPoint): Boolean; override;
204
254
    procedure MouseDown(
205
255
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
206
256
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
207
257
    procedure MouseUp(
208
258
      AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); override;
 
259
  protected
 
260
    procedure Clear(ADrawer: IChartDrawer; const ARect: TRect);
 
261
    procedure DisplaySeries(ADrawer: IChartDrawer);
 
262
    procedure DrawBackWall(ADrawer: IChartDrawer);
 
263
    procedure KeyDownAfterInterface(var AKey: Word; AShift: TShiftState); override;
 
264
    procedure KeyUpAfterInterface(var AKey: Word; AShift: TShiftState); override;
209
265
    {$IFDEF LCLGtk2}
210
266
    procedure DoOnResize; override;
211
267
    {$ENDIF}
212
268
    procedure Notification(
213
269
      AComponent: TComponent; AOperation: TOperation); override;
214
 
    procedure PrepareAxis(ACanvas: TCanvas);
215
 
    procedure PrepareLegend(
216
 
      ACanvas: TCanvas; out ALegendItems: TChartLegendItems;
217
 
      var AClipRect: TRect; out ALegendRect: TRect);
 
270
    procedure PrepareAxis(ADrawer: IChartDrawer);
 
271
    function PrepareLegend(
 
272
      ADrawer: IChartDrawer; var AClipRect: TRect): TChartLegendDrawingData;
 
273
    procedure SetName(const AValue: TComponentName); override;
218
274
  public
219
275
    constructor Create(AOwner: TComponent); override;
220
276
    destructor Destroy; override;
224
280
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
225
281
 
226
282
  public // Helpers for series drawing
227
 
    procedure DrawLineHoriz(ACanvas: TCanvas; AY: Integer);
228
 
    procedure DrawLineVert(ACanvas: TCanvas; AX: Integer);
 
283
    procedure DrawLineHoriz(ADrawer: IChartDrawer; AY: Integer);
 
284
    procedure DrawLineVert(ADrawer: IChartDrawer; AX: Integer);
229
285
    procedure DrawOnCanvas(Rect: TRect; ACanvas: TCanvas); deprecated;
230
286
    function IsPointInViewPort(const AP: TDoublePoint): Boolean;
231
287
 
232
288
  public
233
289
    procedure AddSeries(ASeries: TBasicChartSeries);
234
290
    procedure ClearSeries;
 
291
    function Clone: TChart;
235
292
    procedure CopyToClipboardBitmap;
236
293
    procedure DeleteSeries(ASeries: TBasicChartSeries);
 
294
    procedure DisableRedrawing;
 
295
    procedure Draw(ADrawer: IChartDrawer; const ARect: TRect);
237
296
    procedure DrawLegendOn(ACanvas: TCanvas; var ARect: TRect);
 
297
    procedure EnableRedrawing;
238
298
    function GetFullExtent: TDoubleRect;
 
299
    function GetLegendItems(AIncludeHidden: Boolean = false): TChartLegendItems;
 
300
    procedure PaintOnAuxCanvas(ACanvas: TCanvas; ARect: TRect);
239
301
    procedure PaintOnCanvas(ACanvas: TCanvas; ARect: TRect);
 
302
    procedure Prepare;
240
303
    procedure SaveToBitmapFile(const AFileName: String); inline;
241
 
    procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
 
304
    procedure SaveToFile(AClass: TRasterImageClass; AFileName: String);
242
305
    function SaveToImage(AClass: TRasterImageClass): TRasterImage;
243
306
    procedure StyleChanged(Sender: TObject); override;
244
307
    procedure ZoomFull; override;
 
308
    property Drawer: IChartDrawer read FDrawer;
 
309
 
245
310
  public // Coordinate conversion
246
311
    function GraphToImage(const AGraphPoint: TDoublePoint): TPoint;
247
312
    function ImageToGraph(const APoint: TPoint): TDoublePoint;
257
322
    property ChartWidth: Integer read GetChartWidth;
258
323
    property ClipRect: TRect read FClipRect;
259
324
    property CurrentExtent: TDoubleRect read FCurrentExtent;
 
325
    property ExtentBroadcaster: TBroadcaster read FExtentBroadcaster;
 
326
    property IsZoomed: Boolean read FIsZoomed;
260
327
    property LogicalExtent: TDoubleRect read FLogicalExtent write SetLogicalExtent;
 
328
    property OnChartPaint: TChartPaintEvent
 
329
      read FOnChartPaint write SetOnChartPaint; experimental;
 
330
    property RenderingParams: TChartRenderingParams
 
331
      read GetRenderingParams write SetRenderingParams;
261
332
    property ReticulePos: TPoint read FReticulePos write SetReticulePos;
262
333
    property SeriesCount: Integer read GetSeriesCount;
263
334
    property XGraphMax: Double read FCurrentExtent.b.X;
267
338
 
268
339
  published
269
340
    property AllowZoom: Boolean read FAllowZoom write FAllowZoom default true;
 
341
    property AntialiasingMode: TChartAntialiasingMode
 
342
      read FAntialiasingMode write SetAntialiasingMode default amDontCare;
270
343
    property AxisList: TChartAxisList read FAxisList write SetAxisList;
271
344
    property AxisVisible: Boolean read FAxisVisible write SetAxisVisible default true;
272
345
    property BackColor: TColor read FBackColor write SetBackColor default clBtnFace;
275
348
    property ExpandPercentage: Integer
276
349
      read FExpandPercentage write SetExpandPercentage default 0;
277
350
    property Extent: TChartExtent read FExtent write SetExtent;
 
351
    property ExtentSizeLimit: TChartExtent read FExtentSizeLimit write SetExtentSizeLimit;
278
352
    property Foot: TChartTitle read FFoot write SetFoot;
279
353
    property Frame: TChartPen read FFrame write SetFrame;
280
354
    property GraphBrush: TBrush read FGraphBrush write SetGraphBrush;
281
355
    property LeftAxis: TChartAxis index 2 read GetAxis write SetAxis stored false;
282
356
    property Legend: TChartLegend read FLegend write SetLegend;
283
357
    property Margins: TChartMargins read FMargins write SetMargins;
 
358
    property MarginsExternal: TChartMargins
 
359
      read FMarginsExternal write SetMarginsExternal;
284
360
    property Proportional: Boolean
285
361
      read FProportional write SetProportional default false;
286
362
    property ReticuleMode: TReticuleMode
290
366
    property Toolset: TBasicChartToolset read FToolset write SetToolset;
291
367
 
292
368
  published
 
369
    property OnAfterDrawBackground: TChartAfterDrawEvent
 
370
      read FOnAfterDrawBackground write SetOnAfterDrawBackground;
 
371
    property OnAfterDrawBackWall: TChartAfterDrawEvent
 
372
      read FOnAfterDrawBackWall write SetOnAfterDrawBackWall;
 
373
    property OnAfterPaint: TChartEvent read FOnAfterPaint write FOnAfterPaint;
 
374
    property OnBeforeDrawBackground: TChartBeforeDrawEvent
 
375
      read FOnBeforeDrawBackground write SetOnBeforeDrawBackground;
 
376
    property OnBeforeDrawBackWall: TChartBeforeDrawEvent
 
377
      read FOnBeforeDrawBackWall write SetOnBeforeDrawBackWall;
293
378
    property OnDrawReticule: TDrawReticuleEvent
294
 
      read FOnDrawReticule write FOnDrawReticule;
 
379
      read FOnDrawReticule write SetOnDrawReticule;
 
380
    property OnExtentChanged: TChartEvent read FOnExtentChanged write FOnExtentChanged;
295
381
 
296
382
  published
297
383
    property Align;
330
416
implementation
331
417
 
332
418
uses
333
 
  Clipbrd, GraphMath, LCLProc, Math, Types, TADrawUtils;
 
419
  Clipbrd, Dialogs, GraphMath, LCLProc, LResources, Math, TADrawerCanvas,
 
420
  TAGeometry, TAMath, Types;
334
421
 
335
422
function CompareZPosition(AItem1, AItem2: Pointer): Integer;
336
423
begin
351
438
  end;
352
439
end;
353
440
 
354
 
procedure RegisterSeriesClass(ASeriesClass: TSeriesClass; const ACaption: string);
 
441
procedure RegisterSeriesClass(
 
442
  ASeriesClass: TSeriesClass; const ACaption: String);
355
443
begin
356
444
  if SeriesClassRegistry.IndexOfObject(TObject(ASeriesClass)) < 0 then
357
445
    SeriesClassRegistry.AddObject(ACaption, TObject(ASeriesClass));
358
446
end;
359
447
 
 
448
procedure WriteComponentToStream(AStream: TStream; AComponent: TComponent);
 
449
var
 
450
  writer: TWriter;
 
451
  destroyDriver: Boolean = false;
 
452
begin
 
453
  writer := CreateLRSWriter(AStream, destroyDriver);
 
454
  try
 
455
    writer.Root := AComponent.Owner;
 
456
    writer.WriteComponent(AComponent);
 
457
  finally
 
458
    if destroyDriver then
 
459
      writer.Driver.Free;
 
460
    writer.Free;
 
461
  end;
 
462
end;
 
463
 
 
464
{ TBasicChartSeriesEnumerator }
 
465
 
 
466
function TBasicChartSeriesEnumerator.GetCurrent: TBasicChartSeries;
 
467
begin
 
468
  Result := TBasicChartSeries(inherited GetCurrent);
 
469
end;
 
470
 
360
471
{ TChart }
361
472
 
 
473
procedure TChart.AddSeries(ASeries: TBasicChartSeries);
 
474
begin
 
475
  if ASeries.FChart = Self then exit;
 
476
  if ASeries.FChart <> nil then
 
477
    ASeries.FChart.DeleteSeries(ASeries);
 
478
  HideReticule;
 
479
  Series.FList.Add(ASeries);
 
480
  ASeries.FChart := Self;
 
481
  ASeries.AfterAdd;
 
482
  StyleChanged(ASeries);
 
483
end;
 
484
 
 
485
procedure TChart.CalculateTransformationCoeffs(const AMargin: TRect);
 
486
var
 
487
  rX, rY: TAxisCoeffHelper;
 
488
begin
 
489
  rX.Init(
 
490
    BottomAxis, FClipRect.Left, FClipRect.Right, AMargin.Left, -AMargin.Right,
 
491
    @FCurrentExtent.a.X, @FCurrentExtent.b.X);
 
492
  rY.Init(
 
493
    LeftAxis, FClipRect.Bottom, FClipRect.Top, -AMargin.Bottom, AMargin.Top,
 
494
    @FCurrentExtent.a.Y, @FCurrentExtent.b.Y);
 
495
  FScale.X := rX.CalcScale(1);
 
496
  FScale.Y := rY.CalcScale(-1);
 
497
  if Proportional then begin
 
498
    if Abs(FScale.X) > Abs(FScale.Y) then
 
499
      FScale.X := Abs(FScale.Y) * Sign(FScale.X)
 
500
    else
 
501
      FScale.Y := Abs(FScale.X) * Sign(FScale.Y);
 
502
  end;
 
503
  FOffset.X := rX.CalcOffset(FScale.X);
 
504
  FOffset.Y := rY.CalcOffset(FScale.Y);
 
505
  rX.UpdateMinMax(@XImageToGraph);
 
506
  rY.UpdateMinMax(@YImageToGraph);
 
507
end;
 
508
 
 
509
procedure TChart.Clear(ADrawer: IChartDrawer; const ARect: TRect);
 
510
var
 
511
  defaultDrawing: Boolean = true;
 
512
  ic: IChartTCanvasDrawer;
 
513
begin
 
514
  ADrawer.PrepareSimplePen(Color);
 
515
  ADrawer.SetBrushParams(bsSolid, Color);
 
516
  if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnBeforeDrawBackground) then
 
517
    OnBeforeDrawBackground(Self, ic.Canvas, ARect, defaultDrawing);
 
518
  if defaultDrawing then
 
519
    ADrawer.Rectangle(ARect);
 
520
  if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnAfterDrawBackground) then
 
521
    OnAfterDrawBackground(Self, ic.Canvas, ARect);
 
522
end;
 
523
 
 
524
procedure TChart.ClearSeries;
 
525
begin
 
526
  FSeries.Clear;
 
527
  StyleChanged(Self);
 
528
end;
 
529
 
 
530
function TChart.ClipRectWithoutFrame(AZPosition: TChartDistance): TRect;
 
531
begin
 
532
  Result := FClipRect;
 
533
  if (AZPosition > 0) or not Frame.Visible or (Frame.Style = psClear) then exit;
 
534
  Result.Left += (Frame.Width + 1) div 2;
 
535
  Result.Top += (Frame.Width + 1) div 2;
 
536
  Result.Bottom -= Frame.Width div 2;
 
537
  Result.Right -= Frame.Width div 2;
 
538
end;
 
539
 
 
540
function TChart.Clone: TChart;
 
541
var
 
542
  ms: TMemoryStream;
 
543
  cloned: TComponent = nil;
 
544
begin
 
545
  ms := TMemoryStream.Create;
 
546
  try
 
547
    WriteComponentToStream(ms, Self);
 
548
    ms.Seek(0, soBeginning);
 
549
    ReadComponentFromBinaryStream(
 
550
      ms, cloned, @FindComponentClass, Owner, Parent, Owner);
 
551
    Result := cloned as TChart;
 
552
  finally
 
553
    ms.Free;
 
554
  end;
 
555
end;
 
556
 
 
557
procedure TChart.CopyToClipboardBitmap;
 
558
begin
 
559
  with SaveToImage(TBitmap) do
 
560
    try
 
561
      SaveToClipboardFormat(RegisterClipboardFormat(MimeType));
 
562
    finally
 
563
      Free;
 
564
    end;
 
565
end;
 
566
 
362
567
constructor TChart.Create(AOwner: TComponent);
363
568
const
364
569
  DEFAULT_CHART_WIDTH = 300;
369
574
  inherited Create(AOwner);
370
575
 
371
576
  FBroadcaster := TBroadcaster.Create;
 
577
  FExtentBroadcaster := TBroadcaster.Create;
372
578
  FAllowZoom := true;
 
579
  FAntialiasingMode := amDontCare;
373
580
  FAxisVisible := true;
 
581
  FDrawer := TCanvasDrawer.Create(Canvas);
 
582
  FScale := DoublePoint(1, 1);
374
583
 
375
584
  Width := DEFAULT_CHART_WIDTH;
376
585
  Height := DEFAULT_CHART_HEIGHT;
407
616
  FFrame.OnChange := @StyleChanged;
408
617
 
409
618
  FExtent := TChartExtent.Create(Self);
 
619
  FExtentSizeLimit := TChartExtent.Create(Self);
410
620
  FMargins := TChartMargins.Create(Self);
 
621
  FMarginsExternal := TChartMargins.Create(Self);
411
622
 
412
623
  FBuiltinToolset := OnInitBuiltinTools(Self);
413
624
  FActiveToolIndex := -1;
 
625
 
 
626
  FLogicalExtent := EmptyExtent;
 
627
  FPrevLogicalExtent := EmptyExtent;
 
628
end;
 
629
 
 
630
procedure TChart.DeleteSeries(ASeries: TBasicChartSeries);
 
631
var
 
632
  i: Integer;
 
633
begin
 
634
  i := FSeries.FList.IndexOf(ASeries);
 
635
  if i < 0 then exit;
 
636
  FSeries.FList.Delete(i);
 
637
  ASeries.FChart := nil;
 
638
  StyleChanged(Self);
414
639
end;
415
640
 
416
641
destructor TChart.Destroy;
424
649
  FreeAndNil(FAxisList);
425
650
  FreeAndNil(FFrame);
426
651
  FreeAndNil(FExtent);
 
652
  FreeAndNil(FExtentSizeLimit);
427
653
  FreeAndNil(FMargins);
 
654
  FreeAndNil(FMarginsExternal);
428
655
  FreeAndNil(FBuiltinToolset);
429
656
  FreeAndNil(FBroadcaster);
 
657
  FreeAndNil(FExtentBroadcaster);
430
658
 
431
659
  DrawData.DeleteByChart(Self);
432
660
  inherited;
433
661
end;
434
662
 
435
 
{$IFDEF LCLGtk2}
436
 
procedure TChart.DoOnResize;
437
 
begin
438
 
  inherited;
439
 
  // FIXME: GTK does not invalidate the control on resizing, do it manually
440
 
  Invalidate;
441
 
end;
442
 
{$ENDIF}
443
 
 
444
 
procedure TChart.EraseBackground(DC: HDC);
445
 
begin
446
 
  // do not erase, since we will paint over it anyway
447
 
  Unused(DC);
448
 
end;
449
 
 
450
 
function TChart.GetAxis(AIndex: integer): TChartAxis;
451
 
begin
452
 
  Result := FAxisList.GetAxis(AIndex);
453
 
end;
454
 
 
455
 
procedure TChart.StyleChanged(Sender: TObject);
456
 
begin
457
 
  if Sender is TChartExtent then
458
 
    ZoomFull;
459
 
  Invalidate;
460
 
  Broadcaster.Broadcast(Sender);
461
 
end;
462
 
 
463
 
procedure TChart.Paint;
464
 
begin
465
 
  PaintOnCanvas(Canvas, GetClientRect);
466
 
end;
467
 
 
468
 
procedure TChart.PaintOnCanvas(ACanvas: TCanvas; ARect: TRect);
469
 
var
470
 
  i: Integer;
471
 
  legendItems: TChartLegendItems = nil;
472
 
  legendRect: TRect;
473
 
begin
474
 
  Clean(ACanvas, ARect);
475
 
 
476
 
  FClipRect := ARect;
477
 
  InflateRect(FClipRect, -2, -2);
478
 
 
479
 
  for i := 0 to AxisList.Count - 1 do
480
 
    with AxisList[i] do
481
 
      if Transformations <> nil then
482
 
        Transformations.SetChart(Self);
483
 
  for i := 0 to SeriesCount - 1 do
484
 
    Series[i].BeforeDraw;
485
 
 
486
 
  if not FIsZoomed then
487
 
    FLogicalExtent := GetFullExtent;
488
 
  FCurrentExtent := FLogicalExtent;
489
 
  DrawTitleFoot(ACanvas);
490
 
  if Legend.Visible then
491
 
    PrepareLegend(ACanvas, legendItems, FClipRect, legendRect);
492
 
  try
493
 
    PrepareAxis(ACanvas);
494
 
    DrawBackground(ACanvas);
495
 
    DisplaySeries(ACanvas);
496
 
    if Legend.Visible then
497
 
      Legend.Draw(ACanvas, legendItems, legendRect);
498
 
  finally
499
 
    legendItems.Free;
500
 
  end;
501
 
  DrawReticule(ACanvas);
502
 
 
503
 
  for i := 0 to SeriesCount - 1 do
504
 
    Series[i].AfterDraw;
505
 
end;
506
 
 
507
 
procedure TChart.PrepareLegend(
508
 
  ACanvas: TCanvas; out ALegendItems: TChartLegendItems;
509
 
  var AClipRect: TRect; out ALegendRect: TRect);
510
 
var
511
 
  i: Integer;
512
 
begin
513
 
  ALegendItems := TChartLegendItems.Create;
514
 
  try
515
 
    for i := 0 to SeriesCount - 1 do
516
 
      with Series[i] do
517
 
        if Active and GetShowInLegend then
518
 
          GetLegendItemsBasic(ALegendItems);
519
 
    ALegendRect := Legend.Prepare(ACanvas, ALegendItems, AClipRect);
520
 
  except
521
 
    FreeAndNil(ALegendItems);
522
 
    raise;
523
 
  end;
524
 
end;
525
 
 
526
 
procedure TChart.DrawBackground(const ACanvas: TCanvas);
527
 
begin
528
 
  with ACanvas do begin
529
 
    if FFrame.Visible then
530
 
      Pen.Assign(FFrame)
531
 
    else
532
 
      Pen.Style := psClear;
533
 
    Brush.Color := BackColor;
534
 
    with FClipRect do
535
 
      Rectangle(Left, Top, Right + 1, Bottom + 1);
536
 
  end;
537
 
 
538
 
  // Z axis
539
 
  if Depth > 0 then
540
 
    with FClipRect do
541
 
      ACanvas.Line(Left, Bottom, Left - Depth, Bottom + Depth);
542
 
end;
543
 
 
544
 
procedure TChart.HideReticule;
545
 
begin
546
 
  // Hide reticule - - it will be drawn again in the next MouseMove.
547
 
  FReticulePos := Point( - 1, - 1);
548
 
end;
549
 
 
550
 
procedure TChart.CalculateTransformationCoeffs(const AMargin: TRect);
551
 
var
552
 
  rX, rY: TAxisCoeffHelper;
553
 
begin
554
 
  rX.Init(
555
 
    BottomAxis, FClipRect.Left, FClipRect.Right, AMargin.Left, -AMargin.Right,
556
 
    @FCurrentExtent.a.X, @FCurrentExtent.b.X);
557
 
  rY.Init(
558
 
    LeftAxis, FClipRect.Bottom, FClipRect.Top, -AMargin.Bottom, AMargin.Top,
559
 
    @FCurrentExtent.a.Y, @FCurrentExtent.b.Y);
560
 
  FScale.X := rX.CalcScale(1);
561
 
  FScale.Y := rY.CalcScale(-1);
562
 
  if Proportional then begin
563
 
    if Abs(FScale.X) > Abs(FScale.Y) then
564
 
      FScale.X := Abs(FScale.Y) * Sign(FScale.X)
565
 
    else
566
 
      FScale.Y := Abs(FScale.X) * Sign(FScale.Y);
567
 
  end;
568
 
  FOffset.X := rX.CalcOffset(FScale.X);
569
 
  FOffset.Y := rY.CalcOffset(FScale.Y);
570
 
  rX.UpdateMinMax(@XImageToGraph);
571
 
  rY.UpdateMinMax(@YImageToGraph);
572
 
end;
573
 
 
574
 
procedure TChart.Clean(ACanvas: TCanvas; ARect: TRect);
575
 
begin
576
 
  PrepareSimplePen(ACanvas, Color);
577
 
  ACanvas.Brush.Color := Color;
578
 
  ACanvas.Brush.Style := bsSolid;
579
 
  ACanvas.Rectangle(ARect);
580
 
end;
581
 
 
582
 
procedure TChart.ClearSeries;
583
 
begin
584
 
  FSeries.Clear;
585
 
  Invalidate;
586
 
end;
587
 
 
588
 
procedure TChart.DrawTitleFoot(ACanvas: TCanvas);
589
 
 
590
 
  function AlignedTextPos(AAlign: TAlignment; const AText: String): TSize;
591
 
  begin
592
 
    Result := ACanvas.TextExtent(AText);
593
 
    case AAlign of
594
 
      taLeftJustify:
595
 
        Result.cx := FClipRect.Left;
596
 
      taCenter:
597
 
        Result.cx := (FClipRect.Left + FClipRect.Right - Result.cx) div 2;
598
 
      taRightJustify:
599
 
        Result.cx := FClipRect.Right - Result.cx;
600
 
    end;
601
 
  end;
602
 
 
603
 
var
604
 
  sz: TSize;
605
 
  i: Integer;
606
 
  pbf: TPenBrushFontRecall;
607
 
begin
608
 
  pbf := TPenBrushFontRecall.Create(ACanvas, [pbfBrush, pbfFont]);
609
 
  try
610
 
    with FTitle do
611
 
      if Visible and (Text.Count > 0) then begin
612
 
        ACanvas.Brush.Assign(Brush);
613
 
        ACanvas.Font.Assign(Font);
614
 
        for i := 0 to Text.Count - 1 do begin
615
 
          sz := AlignedTextPos(Alignment, Text[i]);
616
 
          ACanvas.TextOut(sz.cx, FClipRect.Top, Text[i]);
617
 
          FClipRect.Top += sz.cy;
618
 
        end;
619
 
        FClipRect.Top += Margin;
620
 
      end;
621
 
    with FFoot do
622
 
      if Visible and (Text.Count > 0) then begin
623
 
        ACanvas.Brush.Assign(Brush);
624
 
        ACanvas.Font.Assign(Font);
625
 
        for i := Text.Count - 1 downto 0 do begin
626
 
          sz := AlignedTextPos(Alignment, Text[i]);
627
 
          FClipRect.Bottom -= sz.cy;
628
 
          ACanvas.TextOut(sz.cx, FClipRect.Bottom, Text[i]);
629
 
        end;
630
 
        FClipRect.Bottom -= Margin;
631
 
      end;
632
 
  finally
633
 
    pbf.Free;
634
 
  end;
635
 
end;
636
 
 
637
 
procedure TChart.PrepareAxis(ACanvas: TCanvas);
638
 
var
639
 
  axisMargin: TChartAxisMargins = (0, 0, 0, 0);
640
 
  a: TChartAxisAlignment;
641
 
begin
642
 
  if not AxisVisible then begin
643
 
    FClipRect.Left += Depth;
644
 
    FClipRect.Bottom -= Depth;
645
 
    CalculateTransformationCoeffs(GetMargins(ACanvas));
646
 
    exit;
647
 
  end;
648
 
 
649
 
  AxisList.PrepareGroups;
650
 
  AxisList.Measure(ACanvas, CurrentExtent, true, axisMargin);
651
 
  axisMargin[calLeft] := Max(axisMargin[calLeft], Depth);
652
 
  axisMargin[calBottom] := Max(axisMargin[calBottom], Depth);
653
 
  for a := Low(a) to High(a) do
654
 
    SideByAlignment(FClipRect, a, -axisMargin[a]);
655
 
 
656
 
  CalculateTransformationCoeffs(GetMargins(ACanvas));
657
 
  AxisList.Measure(ACanvas, CurrentExtent, false, axisMargin);
658
 
  AxisList.Prepare(FClipRect);
659
 
end;
660
 
 
661
 
procedure TChart.DrawLegendOn(ACanvas: TCanvas; var ARect: TRect);
662
 
var
663
 
  legendItems: TChartLegendItems = nil;
664
 
  legendRect: TRect;
665
 
begin
666
 
  try
667
 
    PrepareLegend(ACanvas, legendItems, ARect, legendRect);
668
 
    Legend.Draw(ACanvas, legendItems, legendRect);
669
 
  finally
670
 
    legendItems.Free;
671
 
  end;
672
 
end;
673
 
 
674
 
procedure TChart.DrawLineHoriz(ACanvas: TCanvas; AY: Integer);
675
 
begin
676
 
  if (FClipRect.Top < AY) and (AY < FClipRect.Bottom) then
677
 
    ACanvas.Line(FClipRect.Left, AY, FClipRect.Right, AY);
678
 
end;
679
 
 
680
 
procedure TChart.DrawLineVert(ACanvas: TCanvas; AX: Integer);
681
 
begin
682
 
  if (FClipRect.Left < AX) and (AX < FClipRect.Right) then
683
 
    ACanvas.Line(AX, FClipRect.Top, AX, FClipRect.Bottom);
684
 
end;
685
 
 
686
 
procedure TChart.SetReticuleMode(const AValue: TReticuleMode);
687
 
begin
688
 
  if FReticuleMode = AValue then exit;
689
 
  FReticuleMode := AValue;
690
 
  Invalidate;
691
 
end;
692
 
 
693
 
procedure TChart.SetReticulePos(const AValue: TPoint);
694
 
begin
695
 
  if FReticulePos = AValue then exit;
696
 
  DrawReticule(Canvas);
697
 
  FReticulePos := AValue;
698
 
  DrawReticule(Canvas);
699
 
end;
700
 
 
701
 
procedure TChart.SetTitle(Value: TChartTitle);
702
 
begin
703
 
  FTitle.Assign(Value);
704
 
  Invalidate;
705
 
end;
706
 
 
707
 
procedure TChart.SetToolset(AValue: TBasicChartToolset);
708
 
begin
709
 
  if FToolset = AValue then exit;
710
 
  if FToolset <> nil then
711
 
    RemoveFreeNotification(FToolset);
712
 
  FToolset := AValue;
713
 
  if FToolset <> nil then
714
 
    FreeNotification(FToolset);
715
 
  FActiveToolIndex := -1;
716
 
end;
717
 
 
718
 
procedure TChart.SetFoot(Value: TChartTitle);
719
 
begin
720
 
  FFoot.Assign(Value);
721
 
  Invalidate;
722
 
end;
723
 
 
724
 
 
725
 
function TChart.GetMargins(ACanvas: TCanvas): TRect;
726
 
var
727
 
  i: Integer;
728
 
begin
729
 
  Result := FMargins.Data;
730
 
  for i := 0 to SeriesCount - 1 do
731
 
    if Series[i].Active then
732
 
      Series[i].UpdateMargins(ACanvas, Result);
733
 
end;
734
 
 
735
 
procedure TChart.SetGraphBrush(Value: TBrush);
736
 
begin
737
 
  FGraphBrush.Assign(Value);
738
 
end;
739
 
 
740
 
procedure TChart.AddSeries(ASeries: TBasicChartSeries);
741
 
begin
742
 
  if ASeries.FChart = Self then exit;
743
 
  if ASeries.FChart <> nil then
744
 
    ASeries.FChart.DeleteSeries(ASeries);
745
 
  DrawReticule(Canvas);
746
 
  Series.FList.Add(ASeries);
747
 
  ASeries.FChart := Self;
748
 
  ASeries.AfterAdd;
749
 
  Invalidate;
750
 
end;
751
 
 
752
 
procedure TChart.DeleteSeries(ASeries: TBasicChartSeries);
753
 
var
754
 
  i: Integer;
755
 
begin
756
 
  i := FSeries.FList.IndexOf(ASeries);
757
 
  if i < 0 then exit;
758
 
  FSeries.FList.Delete(i);
759
 
  ASeries.FChart := nil;
760
 
  Invalidate;
761
 
end;
762
 
 
763
 
function TChart.XGraphToImage(AX: Double): Integer;
764
 
begin
765
 
  Result := RoundChecked(FScale.X * AX + FOffset.X);
766
 
end;
767
 
 
768
 
function TChart.YGraphToImage(AY: Double): Integer;
769
 
begin
770
 
  Result := RoundChecked(FScale.Y * AY + FOffset.Y);
771
 
end;
772
 
 
773
 
function TChart.GraphToImage(const AGraphPoint: TDoublePoint): TPoint;
774
 
begin
775
 
  Result := Point(XGraphToImage(AGraphPoint.X), YGraphToImage(AGraphPoint.Y));
776
 
end;
777
 
 
778
 
function TChart.XImageToGraph(AX: Integer): Double;
779
 
begin
780
 
  Result := (AX - FOffset.X) / FScale.X;
781
 
end;
782
 
 
783
 
function TChart.YImageToGraph(AY: Integer): Double;
784
 
begin
785
 
  Result := (AY - FOffset.Y) / FScale.Y;
786
 
end;
787
 
 
788
 
function TChart.ImageToGraph(const APoint: TPoint): TDoublePoint;
789
 
begin
790
 
  Result.X := XImageToGraph(APoint.X);
791
 
  Result.Y := YImageToGraph(APoint.Y);
792
 
end;
793
 
 
794
 
function TChart.IsPointInViewPort(const AP: TDoublePoint): Boolean;
795
 
begin
796
 
  Result :=
797
 
    InRange(AP.X, XGraphMin, XGraphMax) and InRange(AP.Y, YGraphMin, YGraphMax);
798
 
end;
799
 
 
800
 
procedure TChart.SaveToBitmapFile(const AFileName: String);
801
 
begin
802
 
  SaveToFile(TBitmap, AFileName);
803
 
end;
804
 
 
805
 
procedure TChart.SaveToFile(AClass: TRasterImageClass; const AFileName: String);
806
 
begin
807
 
  with SaveToImage(AClass) do
808
 
    try
809
 
      SaveToFile(AFileName);
810
 
    finally
811
 
      Free;
812
 
    end;
813
 
end;
814
 
 
815
 
function TChart.SaveToImage(AClass: TRasterImageClass): TRasterImage;
816
 
begin
817
 
  Result := AClass.Create;
818
 
  try
819
 
    Result.Width := Width;
820
 
    Result.Height := Height;
821
 
    PaintOnCanvas(Result.Canvas, Rect(0, 0, Width, Height));
822
 
  except
823
 
    Result.Free;
824
 
    raise;
825
 
  end;
826
 
end;
827
 
 
828
 
procedure TChart.SetAxis(AIndex: Integer; AValue: TChartAxis);
829
 
begin
830
 
  FAxisList.SetAxis(AIndex, AValue);
831
 
  Invalidate;
832
 
end;
833
 
 
834
 
procedure TChart.SetAxisList(AValue: TChartAxisList);
835
 
begin
836
 
  FAxisList.Assign(AValue);
837
 
  Invalidate;
838
 
end;
839
 
 
840
 
procedure TChart.CopyToClipboardBitmap;
841
 
begin
842
 
  with SaveToImage(TBitmap) do
843
 
    try
844
 
      SaveToClipboardFormat(RegisterClipboardFormat(MimeType));
845
 
    finally
846
 
      Free;
847
 
    end;
848
 
end;
849
 
 
850
 
procedure TChart.DrawOnCanvas(Rect: TRect; ACanvas: TCanvas);
851
 
begin
852
 
  PaintOnCanvas(ACanvas, Rect);
853
 
end;
854
 
 
855
 
procedure TChart.DisplaySeries(ACanvas: TCanvas);
 
663
procedure TChart.DisableRedrawing;
 
664
begin
 
665
  FDisableRedrawingCounter += 1;
 
666
end;
 
667
 
 
668
procedure TChart.DisplaySeries(ADrawer: IChartDrawer);
856
669
 
857
670
  procedure OffsetDrawArea(AZPos, ADepth: Integer);
858
671
  begin
880
693
          if not Active then continue;
881
694
          // Interleave axises with series according to ZPosition.
882
695
          if AxisVisible then
883
 
            AxisList.Draw(ACanvas, CurrentExtent, Self, ZPosition, d, axisIndex);
 
696
            AxisList.Draw(ZPosition, axisIndex);
884
697
          OffsetDrawArea(Min(ZPosition, d), Min(Depth, d));
885
 
          ACanvas.ClipRect := FClipRect;
886
 
          ACanvas.Clipping := true;
 
698
          ADrawer.ClippingStart(ClipRectWithoutFrame(ZPosition));
887
699
          try
888
700
            try
889
 
              Draw(ACanvas);
 
701
              Draw(ADrawer);
890
702
            except
891
703
              Active := false;
892
704
              raise;
893
705
            end;
894
706
          finally
895
707
            OffsetDrawArea(-Min(ZPosition, d), -Min(Depth, d));
896
 
            ACanvas.Clipping := false;
 
708
            ADrawer.ClippingStop;
897
709
          end;
898
710
        end;
899
711
    finally
901
713
    end;
902
714
  end;
903
715
  if AxisVisible then
904
 
    AxisList.Draw(ACanvas, CurrentExtent, Self, MaxInt, d, axisIndex);
905
 
end;
906
 
 
907
 
procedure TChart.DrawReticule(ACanvas: TCanvas);
908
 
begin
909
 
  PrepareXorPen(ACanvas);
 
716
    AxisList.Draw(MaxInt, axisIndex);
 
717
end;
 
718
 
 
719
function TChart.DoMouseWheel(
 
720
  AShift: TShiftState; AWheelDelta: Integer; AMousePos: TPoint): Boolean;
 
721
const
 
722
  EV: array [Boolean] of TChartToolEventId = (
 
723
    evidMouseWheelDown, evidMouseWheelUp);
 
724
begin
 
725
  Result :=
 
726
    GetToolset.Dispatch(Self, EV[AWheelDelta > 0], AShift, AMousePos) or
 
727
    inherited DoMouseWheel(AShift, AWheelDelta, AMousePos);
 
728
end;
 
729
 
 
730
{$IFDEF LCLGtk2}
 
731
procedure TChart.DoOnResize;
 
732
begin
 
733
  inherited;
 
734
  // FIXME: GTK does not invalidate the control on resizing, do it manually
 
735
  Invalidate;
 
736
end;
 
737
{$ENDIF}
 
738
 
 
739
procedure TChart.Draw(ADrawer: IChartDrawer; const ARect: TRect);
 
740
var
 
741
  ldd: TChartLegendDrawingData;
 
742
  s: TBasicChartSeries;
 
743
begin
 
744
  Prepare;
 
745
 
 
746
  ADrawer.DrawingBegin(ARect);
 
747
  ADrawer.SetAntialiasingMode(AntialiasingMode);
 
748
  Clear(ADrawer, ARect);
 
749
 
 
750
  FClipRect := ARect;
 
751
  with MarginsExternal do begin
 
752
    FClipRect.Left += Left;
 
753
    FClipRect.Top += Top;
 
754
    FClipRect.Right -= Right;
 
755
    FClipRect.Bottom -= Bottom;
 
756
  end;
 
757
 
 
758
  with ClipRect do begin;
 
759
    FTitle.Draw(ADrawer, 1, Left, Right, Top);
 
760
    FFoot.Draw(ADrawer, -1, Left, Right, Bottom);
 
761
  end;
 
762
 
 
763
  ldd.FItems := nil;
 
764
  if Legend.Visible then
 
765
    ldd := PrepareLegend(ADrawer, FClipRect);
 
766
  try
 
767
    PrepareAxis(ADrawer);
 
768
    DrawBackWall(ADrawer);
 
769
    DisplaySeries(ADrawer);
 
770
    if Legend.Visible then
 
771
      Legend.Draw(ldd);
 
772
  finally
 
773
    ldd.FItems.Free;
 
774
  end;
 
775
  DrawReticule(ADrawer);
 
776
  GetToolset.Draw(Self, ADrawer);
 
777
 
 
778
  for s in Series do
 
779
    s.AfterDraw;
 
780
  ADrawer.DrawingEnd;
 
781
 
 
782
  if FPrevLogicalExtent <> FLogicalExtent then begin
 
783
    FExtentBroadcaster.Broadcast(Self);
 
784
    if Assigned(OnExtentChanged) then
 
785
      OnExtentChanged(Self);
 
786
    FPrevLogicalExtent := FLogicalExtent;
 
787
  end;
 
788
end;
 
789
 
 
790
procedure TChart.DrawBackWall(ADrawer: IChartDrawer);
 
791
var
 
792
  defaultDrawing: Boolean = true;
 
793
  ic: IChartTCanvasDrawer;
 
794
begin
 
795
  if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnBeforeDrawBackWall) then
 
796
    OnBeforeDrawBackWall(Self, ic.Canvas, FClipRect, defaultDrawing);
 
797
  if defaultDrawing then
 
798
    with ADrawer do begin
 
799
      if FFrame.Visible then
 
800
        Pen := FFrame
 
801
      else
 
802
        SetPenParams(psClear, clTAColor);
 
803
      SetBrushParams(bsSolid, BackColor);
 
804
      with FClipRect do
 
805
        Rectangle(Left, Top, Right + 1, Bottom + 1);
 
806
    end;
 
807
  if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnAfterDrawBackWall) then
 
808
    OnAfterDrawBackWall(Self, ic.Canvas, FClipRect);
 
809
 
 
810
  // Z axis
 
811
  if (Depth > 0) and FFrame.Visible then begin
 
812
    ADrawer.Pen := FFrame;
 
813
    with FClipRect do
 
814
      ADrawer.Line(Left, Bottom, Left - Depth, Bottom + Depth);
 
815
  end;
 
816
end;
 
817
 
 
818
procedure TChart.DrawLegendOn(ACanvas: TCanvas; var ARect: TRect);
 
819
var
 
820
  ldd: TChartLegendDrawingData;
 
821
begin
 
822
  ldd := PrepareLegend(TCanvasDrawer.Create(ACanvas), ARect);
 
823
  try
 
824
    Legend.Draw(ldd);
 
825
  finally
 
826
    ldd.FItems.Free;
 
827
  end;
 
828
end;
 
829
 
 
830
procedure TChart.DrawLineHoriz(ADrawer: IChartDrawer; AY: Integer);
 
831
begin
 
832
  if (FClipRect.Top < AY) and (AY < FClipRect.Bottom) then
 
833
    ADrawer.Line(FClipRect.Left, AY, FClipRect.Right, AY);
 
834
end;
 
835
 
 
836
procedure TChart.DrawLineVert(ADrawer: IChartDrawer; AX: Integer);
 
837
begin
 
838
  if (FClipRect.Left < AX) and (AX < FClipRect.Right) then
 
839
    ADrawer.Line(AX, FClipRect.Top, AX, FClipRect.Bottom);
 
840
end;
 
841
 
 
842
procedure TChart.DrawOnCanvas(Rect: TRect; ACanvas: TCanvas);
 
843
begin
 
844
  PaintOnCanvas(ACanvas, Rect);
 
845
end;
 
846
 
 
847
procedure TChart.DrawReticule(ADrawer: IChartDrawer);
 
848
var
 
849
  ic: IChartTCanvasDrawer;
 
850
begin
 
851
  if not Supports(ADrawer, IChartTCanvasDrawer, ic) then exit;
 
852
  PrepareXorPen(ic.Canvas);
910
853
  if ReticuleMode in [rmVertical, rmCross] then
911
 
    DrawLineVert(ACanvas, FReticulePos.X);
 
854
    DrawLineVert(ADrawer, FReticulePos.X);
912
855
  if ReticuleMode in [rmHorizontal, rmCross] then
913
 
    DrawLineHoriz(ACanvas, FReticulePos.Y);
914
 
end;
915
 
 
916
 
procedure TChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
917
 
begin
918
 
  if
919
 
    PtInRect(FClipRect, Point(X, Y)) and
920
 
    GetToolset.Dispatch(Self, evidMouseDown, Shift, Point(X, Y))
921
 
  then
922
 
    exit;
923
 
  inherited;
924
 
end;
925
 
 
926
 
procedure TChart.MouseMove(Shift: TShiftState; X, Y: Integer);
927
 
begin
928
 
  if GetToolset.Dispatch(Self, evidMouseMove, Shift, Point(X, Y)) then exit;
929
 
  inherited;
930
 
end;
931
 
 
932
 
procedure TChart.MouseUp(
933
 
  AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer);
934
 
const
935
 
  MOUSE_BUTTON_TO_SHIFT: array [TMouseButton] of TShiftStateEnum = (
936
 
    ssLeft, ssRight, ssMiddle, ssExtra1, ssExtra2);
937
 
begin
938
 
  // To find a tool, toolset must see the shift state with the button still down.
939
 
  Include(AShift, MOUSE_BUTTON_TO_SHIFT[AButton]);
940
 
  if GetToolset.Dispatch(Self, evidMouseUp, AShift, Point(AX, AY)) then exit;
941
 
  inherited;
942
 
end;
943
 
 
944
 
procedure TChart.Notification(AComponent: TComponent; AOperation: TOperation);
945
 
begin
946
 
  if (AOperation = opRemove) and (AComponent = Toolset) then
947
 
    FToolset := nil;
948
 
  inherited Notification(AComponent, AOperation);
949
 
end;
950
 
 
951
 
procedure TChart.SetLegend(Value: TChartLegend);
952
 
begin
953
 
  FLegend.Assign(Value);
954
 
  Invalidate;
955
 
end;
956
 
 
957
 
procedure TChart.SetLogicalExtent(const AValue: TDoubleRect);
958
 
begin
959
 
  HideReticule;
960
 
  FLogicalExtent := AValue;
961
 
  FIsZoomed := true;
962
 
  Invalidate;
963
 
end;
964
 
 
965
 
procedure TChart.SetMargins(AValue: TChartMargins);
966
 
begin
967
 
  FMargins.Assign(AValue);
968
 
  Invalidate;
969
 
end;
970
 
 
971
 
procedure TChart.SetProportional(AValue: Boolean);
972
 
begin
973
 
  if FProportional = AValue then exit;
974
 
  FProportional := AValue;
975
 
  Invalidate;
976
 
end;
977
 
 
978
 
procedure TChart.SetChildOrder(Child: TComponent; Order: Integer);
 
856
    DrawLineHoriz(ADrawer, FReticulePos.Y);
 
857
end;
 
858
 
 
859
procedure TChart.EnableRedrawing;
 
860
begin
 
861
  FDisableRedrawingCounter -= 1;
 
862
end;
 
863
 
 
864
procedure TChart.EraseBackground(DC: HDC);
 
865
begin
 
866
  // do not erase, since we will paint over it anyway
 
867
  Unused(DC);
 
868
end;
 
869
 
 
870
procedure TChart.FindComponentClass(
 
871
  AReader: TReader; const AClassName: String; var AClass: TComponentClass);
979
872
var
980
873
  i: Integer;
981
874
begin
982
 
  i := Series.FList.IndexOf(Child);
983
 
  if i >= 0 then
984
 
    Series.FList.Move(i, Order);
985
 
end;
986
 
 
987
 
procedure TChart.SetDepth(AValue: TChartDistance);
988
 
begin
989
 
  if FDepth = AValue then exit;
990
 
  FDepth := AValue;
991
 
  Invalidate;
992
 
end;
993
 
 
994
 
procedure TChart.SetExpandPercentage(AValue: Integer);
995
 
begin
996
 
  if FExpandPercentage = AValue then exit;
997
 
  FExpandPercentage := AValue;
998
 
  Invalidate;
999
 
end;
1000
 
 
1001
 
procedure TChart.SetExtent(const AValue: TChartExtent);
1002
 
begin
1003
 
  FExtent.Assign(AValue);
1004
 
  Invalidate;
1005
 
end;
1006
 
 
1007
 
procedure TChart.SetFrame(Value: TChartPen);
1008
 
begin
1009
 
  FFrame.Assign(Value);
1010
 
  Invalidate;
1011
 
end;
1012
 
 
1013
 
procedure TChart.SetAxisVisible(Value: Boolean);
1014
 
begin
1015
 
  FAxisVisible := Value;
1016
 
  Invalidate;
1017
 
end; 
1018
 
 
1019
 
procedure TChart.SetBackColor(const AValue: TColor);
1020
 
begin
1021
 
  FBackColor:= AValue;
1022
 
  Invalidate;
 
875
  Unused(AReader);
 
876
  if AClassName = ClassName then begin
 
877
    AClass := TChart;
 
878
    exit;
 
879
  end;
 
880
  for i := 0 to SeriesClassRegistry.Count - 1 do begin
 
881
    AClass := TSeriesClass(SeriesClassRegistry.Objects[i]);
 
882
    if AClass.ClassNameIs(AClassName) then exit;
 
883
  end;
 
884
  AClass := nil;
 
885
end;
 
886
 
 
887
function TChart.GetAxis(AIndex: Integer): TChartAxis;
 
888
begin
 
889
  Result := FAxisList.GetAxis(AIndex);
1023
890
end;
1024
891
 
1025
892
function TChart.GetChartHeight: Integer;
1034
901
 
1035
902
procedure TChart.GetChildren(AProc: TGetChildProc; ARoot: TComponent);
1036
903
var
1037
 
  i: Integer;
 
904
  s: TBasicChartSeries;
1038
905
begin
1039
906
  // FIXME: This is a workaround for issue #16035
1040
907
  if FSeries = nil then exit;
1041
 
  for i := 0 to SeriesCount - 1 do
1042
 
    if Series[i].Owner = ARoot then
1043
 
      AProc(Series[i]);
 
908
  for s in Series do
 
909
    if s.Owner = ARoot then
 
910
      AProc(s);
1044
911
end;
1045
912
 
1046
913
function TChart.GetFullExtent: TDoubleRect;
1073
940
    end;
1074
941
  end;
1075
942
 
 
943
  procedure JoinBounds(const ABounds: TDoubleRect);
 
944
  begin
 
945
    with Result do begin
 
946
      a.X := Min(a.X, ABounds.a.X);
 
947
      b.X := Max(b.X, ABounds.b.X);
 
948
      a.Y := Min(a.Y, ABounds.a.Y);
 
949
      b.Y := Max(b.Y, ABounds.b.Y);
 
950
    end;
 
951
  end;
 
952
 
1076
953
var
1077
 
  i: Integer;
1078
 
  seriesBounds: TDoubleRect;
 
954
  seriesBounds, axisBounds: TDoubleRect;
1079
955
  s: TBasicChartSeries;
 
956
  a: TChartAxis;
1080
957
begin
1081
958
  Extent.CheckBoundsOrder;
1082
959
 
1083
 
  for i := 0 to AxisList.Count - 1 do
1084
 
    with AxisList[i] do
1085
 
      if Transformations <> nil then
1086
 
        Transformations.ClearBounds;
 
960
  for a in AxisList do
 
961
    if a.Transformations <> nil then
 
962
      a.Transformations.ClearBounds;
1087
963
 
1088
964
  Result := EmptyExtent;
1089
 
  for i := 0 to SeriesCount - 1 do begin
1090
 
    s := Series[i];
 
965
  for s in Series do begin
1091
966
    if not s.Active then continue;
1092
967
    seriesBounds := EmptyExtent;
1093
968
    try
1096
971
      s.Active := false;
1097
972
      raise;
1098
973
    end;
1099
 
    with Result do begin
1100
 
      a.X := Min(a.X, seriesBounds.a.X);
1101
 
      b.X := Max(b.X, seriesBounds.b.X);
1102
 
      a.Y := Min(a.Y, seriesBounds.a.Y);
1103
 
      b.Y := Max(b.Y, seriesBounds.b.Y);
1104
 
    end;
 
974
    JoinBounds(seriesBounds);
 
975
  end;
 
976
  for a in AxisList do begin
 
977
    axisBounds := EmptyExtent;
 
978
    if a.Range.UseMin then
 
979
      TDoublePointBoolArr(axisBounds.a)[a.IsVertical] :=
 
980
        a.GetTransform.AxisToGraph(a.Range.Min);
 
981
    if a.Range.UseMax then
 
982
      TDoublePointBoolArr(axisBounds.b)[a.IsVertical] :=
 
983
        a.GetTransform.AxisToGraph(a.Range.Max);
 
984
    JoinBounds(axisBounds);
1105
985
  end;
1106
986
  with Extent do begin
1107
987
    SetBounds(Result.a.X, Result.b.X, XMin, XMax, UseXMin, UseXMax);
1109
989
  end;
1110
990
end;
1111
991
 
 
992
function TChart.GetLegendItems(AIncludeHidden: Boolean): TChartLegendItems;
 
993
var
 
994
  s: TBasicChartSeries;
 
995
begin
 
996
  Result := TChartLegendItems.Create;
 
997
  try
 
998
    for s in Series do
 
999
      if AIncludeHidden or (s.Active and s.GetShowInLegend) then
 
1000
        try
 
1001
          s.GetLegendItemsBasic(Result);
 
1002
        except
 
1003
          s.SetShowInLegend(AIncludeHidden);
 
1004
          raise;
 
1005
        end;
 
1006
  except
 
1007
    FreeAndNil(Result);
 
1008
    raise;
 
1009
  end;
 
1010
end;
 
1011
 
 
1012
function TChart.GetMargins(ADrawer: IChartDrawer): TRect;
 
1013
var
 
1014
  i: Integer;
 
1015
  a: TRectArray absolute Result;
 
1016
  s: TBasicChartSeries;
 
1017
begin
 
1018
  Result := Rect(0, 0, 0, 0);
 
1019
  for s in Series do
 
1020
    if s.Active then
 
1021
      s.UpdateMargins(ADrawer, Result);
 
1022
  for i := Low(a) to High(a) do
 
1023
    a[i] := ADrawer.Scale(a[i] + TRectArray(Margins.Data)[i]);
 
1024
end;
 
1025
 
 
1026
function TChart.GetRenderingParams: TChartRenderingParams;
 
1027
begin
 
1028
  Result.FScale := FScale;
 
1029
  Result.FOffset := FOffset;
 
1030
  Result.FClipRect := FClipRect;
 
1031
  Result.FLogicalExtent := FLogicalExtent;
 
1032
  Result.FPrevLogicalExtent := FPrevLogicalExtent;
 
1033
  Result.FIsZoomed := FIsZoomed;
 
1034
end;
 
1035
 
1112
1036
function TChart.GetSeriesCount: Integer;
1113
1037
begin
1114
1038
  Result := FSeries.FList.Count;
1121
1045
    Result := FBuiltinToolset;
1122
1046
end;
1123
1047
 
 
1048
function TChart.GraphToImage(const AGraphPoint: TDoublePoint): TPoint;
 
1049
begin
 
1050
  Result := Point(XGraphToImage(AGraphPoint.X), YGraphToImage(AGraphPoint.Y));
 
1051
end;
 
1052
 
 
1053
procedure TChart.HideReticule;
 
1054
begin
 
1055
  // Hide reticule - - it will be drawn again in the next MouseMove.
 
1056
  FReticulePos := Point( - 1, - 1);
 
1057
end;
 
1058
 
 
1059
function TChart.ImageToGraph(const APoint: TPoint): TDoublePoint;
 
1060
begin
 
1061
  Result.X := XImageToGraph(APoint.X);
 
1062
  Result.Y := YImageToGraph(APoint.Y);
 
1063
end;
 
1064
 
 
1065
function TChart.IsPointInViewPort(const AP: TDoublePoint): Boolean;
 
1066
begin
 
1067
  Result :=
 
1068
    not IsNan(AP) and
 
1069
    InRange(AP.X, XGraphMin, XGraphMax) and InRange(AP.Y, YGraphMin, YGraphMax);
 
1070
end;
 
1071
 
 
1072
procedure TChart.KeyDownAfterInterface(var AKey: Word; AShift: TShiftState);
 
1073
var
 
1074
  p: TPoint;
 
1075
begin
 
1076
  p := ScreenToClient(Mouse.CursorPos);
 
1077
  if GetToolset.Dispatch(Self, evidKeyDown, AShift, p) then exit;
 
1078
  inherited;
 
1079
end;
 
1080
 
 
1081
procedure TChart.KeyUpAfterInterface(var AKey: Word; AShift: TShiftState);
 
1082
var
 
1083
  p: TPoint;
 
1084
begin
 
1085
  p := ScreenToClient(Mouse.CursorPos);
 
1086
  // To find a tool, toolset must see the shift state with the key still down.
 
1087
  case AKey of
 
1088
    VK_CONTROL: AShift += [ssCtrl];
 
1089
    VK_MENU: AShift += [ssAlt];
 
1090
    VK_SHIFT: AShift += [ssShift];
 
1091
  end;
 
1092
  if GetToolset.Dispatch(Self, evidKeyUp, AShift, p) then exit;
 
1093
  inherited;
 
1094
end;
 
1095
 
 
1096
procedure TChart.MouseDown(
 
1097
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 
1098
begin
 
1099
  if
 
1100
    PtInRect(FClipRect, Point(X, Y)) and
 
1101
    GetToolset.Dispatch(Self, evidMouseDown, Shift, Point(X, Y))
 
1102
  then
 
1103
    exit;
 
1104
  inherited;
 
1105
end;
 
1106
 
 
1107
procedure TChart.MouseMove(Shift: TShiftState; X, Y: Integer);
 
1108
begin
 
1109
  if GetToolset.Dispatch(Self, evidMouseMove, Shift, Point(X, Y)) then exit;
 
1110
  inherited;
 
1111
end;
 
1112
 
 
1113
procedure TChart.MouseUp(
 
1114
  AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer);
 
1115
const
 
1116
  MOUSE_BUTTON_TO_SHIFT: array [TMouseButton] of TShiftStateEnum = (
 
1117
    ssLeft, ssRight, ssMiddle, ssExtra1, ssExtra2);
 
1118
begin
 
1119
  // To find a tool, toolset must see the shift state with the button still down.
 
1120
  Include(AShift, MOUSE_BUTTON_TO_SHIFT[AButton]);
 
1121
  if GetToolset.Dispatch(Self, evidMouseUp, AShift, Point(AX, AY)) then exit;
 
1122
  inherited;
 
1123
end;
 
1124
 
 
1125
procedure TChart.Notification(AComponent: TComponent; AOperation: TOperation);
 
1126
begin
 
1127
  if (AOperation = opRemove) and (AComponent = Toolset) then
 
1128
    FToolset := nil;
 
1129
  inherited Notification(AComponent, AOperation);
 
1130
end;
 
1131
 
 
1132
procedure TChart.Paint;
 
1133
var
 
1134
  defaultDrawing: Boolean = true;
 
1135
begin
 
1136
  {$WARNINGS OFF}
 
1137
  if Assigned(OnChartPaint) then
 
1138
    OnChartPaint(Self, GetClientRect, defaultDrawing);
 
1139
  {$WARNINGS ON}
 
1140
  if defaultDrawing then
 
1141
    Draw(FDrawer, GetClientRect);
 
1142
  if Assigned(OnAfterPaint) then
 
1143
    OnAfterPaint(Self);
 
1144
end;
 
1145
 
 
1146
procedure TChart.PaintOnAuxCanvas(ACanvas: TCanvas; ARect: TRect);
 
1147
var
 
1148
  rp: TChartRenderingParams;
 
1149
begin
 
1150
  rp := RenderingParams;
 
1151
  ExtentBroadcaster.Locked := true;
 
1152
  try
 
1153
    FIsZoomed := false;
 
1154
    PaintOnCanvas(ACanvas, ARect);
 
1155
  finally
 
1156
    RenderingParams := rp;
 
1157
    ExtentBroadcaster.Locked := false;
 
1158
  end;
 
1159
end;
 
1160
 
 
1161
procedure TChart.PaintOnCanvas(ACanvas: TCanvas; ARect: TRect);
 
1162
begin
 
1163
  Draw(TCanvasDrawer.Create(ACanvas), ARect);
 
1164
end;
 
1165
 
 
1166
procedure TChart.PrepareAxis(ADrawer: IChartDrawer);
 
1167
var
 
1168
  axisMargin: TChartAxisMargins;
 
1169
  aa: TChartAxisAlignment;
 
1170
  cr: TRect;
 
1171
  tries: Integer;
 
1172
  prevExt: TDoubleRect;
 
1173
  axis: TChartAxis;
 
1174
begin
 
1175
  if not AxisVisible then begin
 
1176
    FClipRect.Left += Depth;
 
1177
    FClipRect.Bottom -= Depth;
 
1178
    CalculateTransformationCoeffs(GetMargins(ADrawer));
 
1179
    exit;
 
1180
  end;
 
1181
 
 
1182
  AxisList.PrepareGroups;
 
1183
  for axis in AxisList do
 
1184
    axis.PrepareHelper(ADrawer, Self, @FClipRect, Depth);
 
1185
 
 
1186
  // There is a cyclic dependency: extent -> visible marks -> margins.
 
1187
  // We recalculate them iteratively hoping that the process converges.
 
1188
  CalculateTransformationCoeffs(Rect(0, 0, 0, 0));
 
1189
  cr := FClipRect;
 
1190
  for tries := 1 to 10 do begin
 
1191
    axisMargin := AxisList.Measure(CurrentExtent, Depth);
 
1192
    axisMargin[calLeft] := Max(axisMargin[calLeft], Depth);
 
1193
    axisMargin[calBottom] := Max(axisMargin[calBottom], Depth);
 
1194
    FClipRect := cr;
 
1195
    for aa := Low(aa) to High(aa) do
 
1196
      SideByAlignment(FClipRect, aa, -axisMargin[aa]);
 
1197
    prevExt := FCurrentExtent;
 
1198
    FCurrentExtent := FLogicalExtent;
 
1199
    CalculateTransformationCoeffs(GetMargins(ADrawer));
 
1200
    if prevExt = FCurrentExtent then break;
 
1201
    prevExt := FCurrentExtent;
 
1202
  end;
 
1203
 
 
1204
  AxisList.Prepare(FClipRect);
 
1205
end;
 
1206
 
 
1207
procedure TChart.Prepare;
 
1208
var
 
1209
  a: TChartAxis;
 
1210
  s: TBasicChartSeries;
 
1211
begin
 
1212
  for a in AxisList do
 
1213
    if a.Transformations <> nil then
 
1214
      a.Transformations.SetChart(Self);
 
1215
  for s in Series do
 
1216
    s.BeforeDraw;
 
1217
 
 
1218
  if not FIsZoomed then
 
1219
    FLogicalExtent := GetFullExtent;
 
1220
  FCurrentExtent := FLogicalExtent;
 
1221
end;
 
1222
 
 
1223
function TChart.PrepareLegend(
 
1224
  ADrawer: IChartDrawer; var AClipRect: TRect): TChartLegendDrawingData;
 
1225
begin
 
1226
  Result.FDrawer := ADrawer;
 
1227
  Result.FItems := GetLegendItems;
 
1228
  try
 
1229
    Legend.SortItemsByOrder(Result.FItems);
 
1230
    Legend.AddGroups(Result.FItems);
 
1231
    Legend.Prepare(Result, AClipRect);
 
1232
  except
 
1233
    FreeAndNil(Result.FItems);
 
1234
    raise;
 
1235
  end;
 
1236
end;
 
1237
 
 
1238
procedure TChart.SaveToBitmapFile(const AFileName: String);
 
1239
begin
 
1240
  SaveToFile(TBitmap, AFileName);
 
1241
end;
 
1242
 
 
1243
procedure TChart.SaveToFile(AClass: TRasterImageClass; AFileName: String);
 
1244
begin
 
1245
  with SaveToImage(AClass) do
 
1246
    try
 
1247
      SaveToFile(AFileName);
 
1248
    finally
 
1249
      Free;
 
1250
    end;
 
1251
end;
 
1252
 
 
1253
function TChart.SaveToImage(AClass: TRasterImageClass): TRasterImage;
 
1254
begin
 
1255
  Result := AClass.Create;
 
1256
  try
 
1257
    Result.Width := Width;
 
1258
    Result.Height := Height;
 
1259
    PaintOnCanvas(Result.Canvas, Rect(0, 0, Width, Height));
 
1260
  except
 
1261
    Result.Free;
 
1262
    raise;
 
1263
  end;
 
1264
end;
 
1265
 
 
1266
procedure TChart.SetAntialiasingMode(AValue: TChartAntialiasingMode);
 
1267
begin
 
1268
  if FAntialiasingMode = AValue then exit;
 
1269
  FAntialiasingMode := AValue;
 
1270
  StyleChanged(Self);
 
1271
end;
 
1272
 
 
1273
procedure TChart.SetAxis(AIndex: Integer; AValue: TChartAxis);
 
1274
begin
 
1275
  FAxisList.SetAxis(AIndex, AValue);
 
1276
  StyleChanged(AValue);
 
1277
end;
 
1278
 
 
1279
procedure TChart.SetAxisList(AValue: TChartAxisList);
 
1280
begin
 
1281
  FAxisList.Assign(AValue);
 
1282
  StyleChanged(Self);
 
1283
end;
 
1284
 
 
1285
procedure TChart.SetAxisVisible(Value: Boolean);
 
1286
begin
 
1287
  FAxisVisible := Value;
 
1288
  StyleChanged(Self);
 
1289
end;
 
1290
 
 
1291
procedure TChart.SetBackColor(AValue: TColor);
 
1292
begin
 
1293
  FBackColor:= AValue;
 
1294
  StyleChanged(Self);
 
1295
end;
 
1296
 
 
1297
procedure TChart.SetChildOrder(Child: TComponent; Order: Integer);
 
1298
var
 
1299
  i: Integer;
 
1300
begin
 
1301
  i := Series.FList.IndexOf(Child);
 
1302
  if i >= 0 then
 
1303
    Series.FList.Move(i, Order);
 
1304
end;
 
1305
 
 
1306
procedure TChart.SetDepth(AValue: TChartDistance);
 
1307
begin
 
1308
  if FDepth = AValue then exit;
 
1309
  FDepth := AValue;
 
1310
  StyleChanged(Self);
 
1311
end;
 
1312
 
 
1313
procedure TChart.SetExpandPercentage(AValue: Integer);
 
1314
begin
 
1315
  if FExpandPercentage = AValue then exit;
 
1316
  FExpandPercentage := AValue;
 
1317
  StyleChanged(Self);
 
1318
end;
 
1319
 
 
1320
procedure TChart.SetExtent(AValue: TChartExtent);
 
1321
begin
 
1322
  FExtent.Assign(AValue);
 
1323
  StyleChanged(Self);
 
1324
end;
 
1325
 
 
1326
procedure TChart.SetExtentSizeLimit(AValue: TChartExtent);
 
1327
begin
 
1328
  if FExtentSizeLimit = AValue then exit;
 
1329
  FExtentSizeLimit.Assign(AValue);
 
1330
  StyleChanged(Self);
 
1331
end;
 
1332
 
 
1333
procedure TChart.SetFoot(Value: TChartTitle);
 
1334
begin
 
1335
  FFoot.Assign(Value);
 
1336
  StyleChanged(Self);
 
1337
end;
 
1338
 
 
1339
procedure TChart.SetFrame(Value: TChartPen);
 
1340
begin
 
1341
  FFrame.Assign(Value);
 
1342
  StyleChanged(Self);
 
1343
end;
 
1344
 
 
1345
procedure TChart.SetGraphBrush(Value: TBrush);
 
1346
begin
 
1347
  FGraphBrush.Assign(Value);
 
1348
end;
 
1349
 
 
1350
procedure TChart.SetLegend(Value: TChartLegend);
 
1351
begin
 
1352
  FLegend.Assign(Value);
 
1353
  StyleChanged(Self);
 
1354
end;
 
1355
 
 
1356
procedure TChart.SetLogicalExtent(const AValue: TDoubleRect);
 
1357
var
 
1358
  w, h: Double;
 
1359
begin
 
1360
  if FLogicalExtent = AValue then exit;
 
1361
  w := Abs(AValue.a.X - AValue.b.X);
 
1362
  h := Abs(AValue.a.Y - AValue.b.Y);
 
1363
  with ExtentSizeLimit do
 
1364
    if
 
1365
      UseXMin and (w < XMin) or UseXMax and (w > XMax) or
 
1366
      UseYMin and (h < YMin) or UseYMax and (h > YMax)
 
1367
    then
 
1368
      exit;
 
1369
  HideReticule;
 
1370
  FLogicalExtent := AValue;
 
1371
  FIsZoomed := true;
 
1372
  StyleChanged(Self);
 
1373
end;
 
1374
 
 
1375
procedure TChart.SetMargins(AValue: TChartMargins);
 
1376
begin
 
1377
  FMargins.Assign(AValue);
 
1378
  StyleChanged(Self);
 
1379
end;
 
1380
 
 
1381
procedure TChart.SetMarginsExternal(AValue: TChartMargins);
 
1382
begin
 
1383
  if FMarginsExternal = AValue then exit;
 
1384
  FMarginsExternal.Assign(AValue);
 
1385
  StyleChanged(Self);
 
1386
end;
 
1387
 
 
1388
procedure TChart.SetName(const AValue: TComponentName);
 
1389
var
 
1390
  oldName: String;
 
1391
begin
 
1392
  if Name = AValue then exit;
 
1393
  oldName := Name;
 
1394
  inherited SetName(AValue);
 
1395
  if csDesigning in ComponentState then
 
1396
    Series.List.ChangeNamePrefix(oldName, AValue);
 
1397
end;
 
1398
 
 
1399
procedure TChart.SetOnAfterDrawBackground(AValue: TChartAfterDrawEvent);
 
1400
begin
 
1401
  if TMethod(FOnAfterDrawBackground) = TMEthod(AValue) then exit;
 
1402
  FOnAfterDrawBackground := AValue;
 
1403
  StyleChanged(Self);
 
1404
end;
 
1405
 
 
1406
procedure TChart.SetOnAfterDrawBackWall(AValue: TChartAfterDrawEvent);
 
1407
begin
 
1408
  if TMethod(FOnAfterDrawBackWall) = TMethod(AValue) then exit;
 
1409
  FOnAfterDrawBackWall := AValue;
 
1410
  StyleChanged(Self);
 
1411
end;
 
1412
 
 
1413
procedure TChart.SetOnBeforeDrawBackground(AValue: TChartBeforeDrawEvent);
 
1414
begin
 
1415
  if TMethod(FOnBeforeDrawBackground) = TMethod(AValue) then exit;
 
1416
  FOnBeforeDrawBackground := AValue;
 
1417
  StyleChanged(Self);
 
1418
end;
 
1419
 
 
1420
procedure TChart.SetOnBeforeDrawBackWall(AValue: TChartBeforeDrawEvent);
 
1421
begin
 
1422
  if TMethod(FOnBeforeDrawBackWall) = TMethod(AValue) then exit;
 
1423
  FOnBeforeDrawBackWall := AValue;
 
1424
  StyleChanged(Self);
 
1425
end;
 
1426
 
 
1427
procedure TChart.SetOnChartPaint(AValue: TChartPaintEvent);
 
1428
begin
 
1429
  if TMethod(FOnChartPaint) = TMethod(AValue) then exit;
 
1430
  FOnChartPaint := AValue;
 
1431
  StyleChanged(Self);
 
1432
end;
 
1433
 
 
1434
procedure TChart.SetOnDrawReticule(AValue: TDrawReticuleEvent);
 
1435
begin
 
1436
  if TMethod(FOnDrawReticule) = TMethod(AValue) then exit;
 
1437
  FOnDrawReticule := AValue;
 
1438
  StyleChanged(Self);
 
1439
end;
 
1440
 
 
1441
procedure TChart.SetProportional(AValue: Boolean);
 
1442
begin
 
1443
  if FProportional = AValue then exit;
 
1444
  FProportional := AValue;
 
1445
  StyleChanged(Self);
 
1446
end;
 
1447
 
 
1448
procedure TChart.SetRenderingParams(AValue: TChartRenderingParams);
 
1449
begin
 
1450
  FScale := AValue.FScale;
 
1451
  FOffset := AValue.FOffset;
 
1452
  FClipRect := AValue.FClipRect;
 
1453
  FLogicalExtent := AValue.FLogicalExtent;
 
1454
  FPrevLogicalExtent := AValue.FPrevLogicalExtent;
 
1455
  FIsZoomed := AValue.FIsZoomed;
 
1456
end;
 
1457
 
 
1458
procedure TChart.SetReticuleMode(AValue: TReticuleMode);
 
1459
begin
 
1460
  if FReticuleMode = AValue then exit;
 
1461
  FReticuleMode := AValue;
 
1462
  StyleChanged(Self);
 
1463
end;
 
1464
 
 
1465
procedure TChart.SetReticulePos(const AValue: TPoint);
 
1466
begin
 
1467
  if FReticulePos = AValue then exit;
 
1468
  DrawReticule(FDrawer);
 
1469
  FReticulePos := AValue;
 
1470
  DrawReticule(FDrawer);
 
1471
end;
 
1472
 
 
1473
procedure TChart.SetTitle(Value: TChartTitle);
 
1474
begin
 
1475
  FTitle.Assign(Value);
 
1476
  StyleChanged(Self);
 
1477
end;
 
1478
 
 
1479
procedure TChart.SetToolset(AValue: TBasicChartToolset);
 
1480
begin
 
1481
  if FToolset = AValue then exit;
 
1482
  if FToolset <> nil then
 
1483
    RemoveFreeNotification(FToolset);
 
1484
  FToolset := AValue;
 
1485
  FActiveToolIndex := -1;
 
1486
  if FToolset <> nil then
 
1487
    FreeNotification(FToolset);
 
1488
end;
 
1489
 
 
1490
procedure TChart.StyleChanged(Sender: TObject);
 
1491
begin
 
1492
  if FDisableRedrawingCounter > 0 then exit;
 
1493
  if Sender is TChartExtent then
 
1494
    ZoomFull;
 
1495
  Invalidate;
 
1496
  Broadcaster.Broadcast(Sender);
 
1497
end;
 
1498
 
1124
1499
procedure TChart.VisitSources(
1125
1500
  AVisitor: TChartOnSourceVisitor; AAxis: TChartAxis; var AData);
1126
1501
var
1127
 
  i: Integer;
1128
 
begin
1129
 
  for i := 0 to SeriesCount - 1 do
1130
 
    with Series[i] do
1131
 
      if Active then
1132
 
        VisitSources(AVisitor, AAxis, AData);
 
1502
  s: TBasicChartSeries;
 
1503
begin
 
1504
  for s in Series do
 
1505
    if s.Active then
 
1506
      s.VisitSources(AVisitor, AAxis, AData);
 
1507
end;
 
1508
 
 
1509
function TChart.XGraphToImage(AX: Double): Integer;
 
1510
begin
 
1511
  Result := RoundChecked(FScale.X * AX + FOffset.X);
 
1512
end;
 
1513
 
 
1514
function TChart.XImageToGraph(AX: Integer): Double;
 
1515
begin
 
1516
  Result := (AX - FOffset.X) / FScale.X;
 
1517
end;
 
1518
 
 
1519
function TChart.YGraphToImage(AY: Double): Integer;
 
1520
begin
 
1521
  Result := RoundChecked(FScale.Y * AY + FOffset.Y);
 
1522
end;
 
1523
 
 
1524
function TChart.YImageToGraph(AY: Integer): Double;
 
1525
begin
 
1526
  Result := (AY - FOffset.Y) / FScale.Y;
1133
1527
end;
1134
1528
 
1135
1529
procedure TChart.ZoomFull;
1147
1541
  // empty
1148
1542
end;
1149
1543
 
 
1544
procedure TBasicChartSeries.Assign(Source: TPersistent);
 
1545
begin
 
1546
  if Source is TBasicChartSeries then
 
1547
    with TBasicChartSeries(Source) do begin
 
1548
      Self.FActive := FActive;
 
1549
      Self.FDepth := FDepth;
 
1550
      Self.FZPosition := FZPosition;
 
1551
    end;
 
1552
end;
 
1553
 
1150
1554
function TBasicChartSeries.AxisToGraphX(AX: Double): Double;
1151
1555
begin
1152
1556
  Result := AX;
1180
1584
end;
1181
1585
 
1182
1586
procedure TBasicChartSeries.MovePoint(
 
1587
  var AIndex: Integer; const ANewPos: TDoublePoint);
 
1588
begin
 
1589
  Unused(AIndex, ANewPos)
 
1590
end;
 
1591
 
 
1592
procedure TBasicChartSeries.MovePoint(
1183
1593
  var AIndex: Integer; const ANewPos: TPoint);
1184
1594
begin
1185
 
  Unused(AIndex, ANewPos)
 
1595
  MovePoint(AIndex, FChart.ImageToGraph(ANewPos));
1186
1596
end;
1187
1597
 
1188
1598
procedure TBasicChartSeries.UpdateMargins(
1189
 
  ACanvas: TCanvas; var AMargins: TRect);
 
1599
  ADrawer: IChartDrawer; var AMargins: TRect);
1190
1600
begin
1191
 
  Unused(ACanvas, AMargins);
 
1601
  Unused(ADrawer, AMargins);
1192
1602
end;
1193
1603
 
1194
1604
procedure TBasicChartSeries.VisitSources(
1220
1630
 
1221
1631
constructor TChartSeriesList.Create;
1222
1632
begin
1223
 
  FList := TFPList.Create;
 
1633
  FList := TIndexedComponentList.Create;
1224
1634
end;
1225
1635
 
1226
1636
destructor TChartSeriesList.Destroy;
1230
1640
  inherited;
1231
1641
end;
1232
1642
 
 
1643
function TChartSeriesList.GetEnumerator: TBasicChartSeriesEnumerator;
 
1644
begin
 
1645
  Result := TBasicChartSeriesEnumerator.Create(FList);
 
1646
end;
 
1647
 
1233
1648
function TChartSeriesList.GetItem(AIndex: Integer): TBasicChartSeries;
1234
1649
begin
1235
1650
  Result := TBasicChartSeries(FList.Items[AIndex]);
1247
1662
begin
1248
1663
  FChart.MouseCapture := false;
1249
1664
  FChart.FActiveToolIndex := -1;
1250
 
  FChart := nil;
1251
1665
end;
1252
1666
 
1253
1667
procedure SkipObsoleteChartProperties;
1274
1688
  {$I tagraph.lrs}
1275
1689
  SkipObsoleteChartProperties;
1276
1690
  SeriesClassRegistry := TStringList.Create;
 
1691
  ShowMessageProc := @ShowMessage;
1277
1692
 
1278
1693
finalization
1279
1694
  FreeAndNil(SeriesClassRegistry);