← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/tachart/tachartaxisutils.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
http://bugs.debian.org/708695
[ 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:
components/tachart/tachartaxisutils.pas
 
1
{
 
2
 
 
3
 *****************************************************************************
 
4
 *                                                                           *
 
5
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 
6
 *  for details about the copyright.                                         *
 
7
 *                                                                           *
 
8
 *  This program is distributed in the hope that it will be useful,          *
 
9
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 
10
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 
11
 *                                                                           *
 
12
 *****************************************************************************
 
13
 
 
14
 Authors: Alexander Klenin
 
15
 
 
16
}
 
17
unit TAChartAxisUtils;
 
18
 
 
19
{$H+}
 
20
 
 
21
interface
 
22
 
 
23
uses
 
24
  Classes, Graphics,
 
25
  TAChartUtils, TACustomSource, TADrawUtils, TAIntervalSources, TAStyles,
 
26
  TATypes;
 
27
 
 
28
const
 
29
  DEF_TITLE_DISTANCE = 4;
 
30
 
 
31
type
 
32
  TChartAxisBrush = class(TBrush)
 
33
  published
 
34
    property Style default bsClear;
 
35
  end;
 
36
 
 
37
  TChartAxisFramePen = class(TChartPen)
 
38
  published
 
39
    property Style default psClear;
 
40
  end;
 
41
 
 
42
  {$IFNDEF fpdoc}  // Workaround for issue #18549.
 
43
  TCustomChartAxisTitle =
 
44
    specialize TGenericChartMarks<TChartAxisBrush, TChartPen, TChartAxisFramePen>;
 
45
  {$ENDIF}
 
46
 
 
47
  { TChartAxisTitle }
 
48
 
 
49
  TChartAxisTitle = class(TCustomChartAxisTitle)
 
50
  strict private
 
51
    FCaption: String;
 
52
    FPositionOnMarks: Boolean;
 
53
 
 
54
    function GetFont: TFont;
 
55
    procedure SetCaption(AValue: String);
 
56
    procedure SetFont(AValue: TFont);
 
57
    procedure SetPositionOnMarks(AValue: Boolean);
 
58
  public
 
59
    constructor Create(AOwner: TCustomChart);
 
60
 
 
61
  public
 
62
    procedure Assign(Source: TPersistent); override;
 
63
  published
 
64
    property Caption: String read FCaption write SetCaption;
 
65
    property Distance default DEF_TITLE_DISTANCE;
 
66
    // Use LabelFont instead.
 
67
    property Font: TFont read GetFont write SetFont stored false; deprecated;
 
68
    property Frame;
 
69
    property LabelBrush;
 
70
    property PositionOnMarks: Boolean
 
71
      read FPositionOnMarks write SetPositionOnMarks default false;
 
72
    property Visible default false;
 
73
  end;
 
74
 
 
75
  ICoordTransformer = interface
 
76
  ['{6EDA0F9F-ED59-4CA6-BA68-E247EB88AE3D}']
 
77
    function XGraphToImage(AX: Double): Integer;
 
78
    function YGraphToImage(AY: Double): Integer;
 
79
  end;
 
80
 
 
81
  TChartAxisAlignment = (calLeft, calTop, calRight, calBottom);
 
82
  TChartAxisMargins = array [TChartAxisAlignment] of Integer;
 
83
  TChartAxisMarkToTextEvent =
 
84
    procedure (var AText: String; AMark: Double) of object;
 
85
 
 
86
  {$IFNDEF fpdoc} // Workaround for issue #18549.
 
87
  TBasicChartAxisMarks =
 
88
    specialize TGenericChartMarks<TChartAxisBrush, TChartPen, TChartAxisFramePen>;
 
89
  {$ENDIF}
 
90
 
 
91
  TCustomChartAxisMarks = class(TBasicChartAxisMarks)
 
92
  strict private
 
93
    FDefaultListener: TListener;
 
94
    FDefaultSource: TIntervalChartSource;
 
95
    FStripes: TChartStyles;
 
96
    procedure SetStripes(AValue: TChartStyles);
 
97
  strict protected
 
98
    function IsFormatStored: Boolean;
 
99
  public
 
100
    constructor Create(AOwner: TCustomChart);
 
101
    destructor Destroy; override;
 
102
    function Measure(
 
103
      ADrawer: IChartDrawer; AIsVertical: Boolean; ATickLength: Integer;
 
104
      AValues: TChartValueTextArray): Integer;
 
105
    property DefaultSource: TIntervalChartSource read FDefaultSource;
 
106
    property Stripes: TChartStyles read FStripes write SetStripes;
 
107
  end;
 
108
 
 
109
  TChartMinorAxisMarks = class(TCustomChartAxisMarks)
 
110
  public
 
111
    constructor Create(AOwner: TCustomChart);
 
112
  published
 
113
    property Distance default 1;
 
114
    property Format;
 
115
    property Frame;
 
116
    property LabelBrush;
 
117
    property OverlapPolicy;
 
118
    property Style default smsNone;
 
119
  end;
 
120
 
 
121
  { TChartAxisMarks }
 
122
 
 
123
  TChartAxisMarks = class(TCustomChartAxisMarks)
 
124
  strict private
 
125
    FAtDataOnly: Boolean;
 
126
    FListener: TListener;
 
127
    FRange: TChartRange;
 
128
    FSource: TCustomChartSource;
 
129
 
 
130
    procedure SetAtDataOnly(AValue: Boolean);
 
131
    procedure SetRange(AValue: TChartRange);
 
132
    procedure SetSource(AValue: TCustomChartSource);
 
133
  public
 
134
    constructor Create(AOwner: TCustomChart);
 
135
    destructor Destroy; override;
 
136
 
 
137
    function SourceDef: TCustomChartSource;
 
138
  published
 
139
    property AtDataOnly: Boolean
 
140
      read FAtDataOnly write SetAtDataOnly default false;
 
141
    property Distance default 1;
 
142
    property Format stored IsFormatStored;
 
143
    property Frame;
 
144
    property LabelBrush;
 
145
    property OverlapPolicy;
 
146
    property Range: TChartRange read FRange write SetRange;
 
147
    property Source: TCustomChartSource read FSource write SetSource;
 
148
    property Stripes;
 
149
    property Style default smsValue;
 
150
    property YIndex;
 
151
  end;
 
152
 
 
153
  TChartAxisGridPen = class(TChartPen)
 
154
  published
 
155
    property Style default psDot;
 
156
  end;
 
157
 
 
158
  TChartBasicAxis = class(TCollectionItem)
 
159
  strict private
 
160
    FArrow: TChartArrow;
 
161
    FGrid: TChartAxisGridPen;
 
162
    FTickColor: TColor;
 
163
    FTickLength: Integer;
 
164
    FVisible: Boolean;
 
165
    function GetIntervals: TChartAxisIntervalParams;
 
166
    procedure SetArrow(AValue: TChartArrow);
 
167
    procedure SetGrid(AValue: TChartAxisGridPen);
 
168
    procedure SetIntervals(AValue: TChartAxisIntervalParams);
 
169
    procedure SetTickColor(AValue: TColor);
 
170
    procedure SetTickLength(AValue: Integer);
 
171
    procedure SetVisible(AValue: Boolean);
 
172
  strict protected
 
173
    FMarks: TCustomChartAxisMarks;
 
174
    function GetAlignment: TChartAxisAlignment; virtual; abstract;
 
175
    procedure SetAlignment(AValue: TChartAxisAlignment); virtual; abstract;
 
176
    procedure SetMarks(AValue: TCustomChartAxisMarks);
 
177
    procedure StyleChanged(ASender: TObject); virtual; abstract;
 
178
  public
 
179
    constructor Create(ACollection: TCollection; AChart: TCustomChart); overload;
 
180
    destructor Destroy; override;
 
181
  public
 
182
    procedure Assign(ASource: TPersistent); override;
 
183
    function TryApplyStripes(
 
184
      ADrawer: IChartDrawer; var AIndex: Cardinal): Boolean;
 
185
 
 
186
    property Alignment: TChartAxisAlignment
 
187
      read GetAlignment write SetAlignment;
 
188
    property Arrow: TChartArrow read FArrow write SetArrow;
 
189
    property Marks: TCustomChartAxisMarks read FMarks write SetMarks;
 
190
  published
 
191
    property Grid: TChartAxisGridPen read FGrid write SetGrid;
 
192
    property Intervals: TChartAxisIntervalParams
 
193
      read GetIntervals write SetIntervals;
 
194
    property TickColor: TColor read FTickColor write SetTickColor default clBlack;
 
195
    property TickLength: Integer read FTickLength write SetTickLength;
 
196
    property Visible: Boolean read FVisible write SetVisible default true;
 
197
  end;
 
198
 
 
199
  { TAxisDrawHelper }
 
200
 
 
201
  TAxisDrawHelper = class
 
202
  strict private
 
203
    FPrevLabelPoly: TPointArray;
 
204
  strict protected
 
205
    procedure BarZ(AX1, AY1, AX2, AY2: Integer); inline;
 
206
    procedure DrawLabel(ALabelCenter: TPoint; const AText: String); inline;
 
207
    procedure DrawLabelAndTick(
 
208
      ACoord, AFixedCoord: Integer; const AText: String); virtual; abstract;
 
209
    procedure GridLine(ACoord: Integer); virtual; abstract;
 
210
    procedure InternalAxisLine(
 
211
      APen: TChartPen; const AStart, AEnd: TPoint; AAngle: Double);
 
212
    function IsInClipRange(ACoord: Integer): Boolean;
 
213
    procedure LineZ(AP1, AP2: TPoint); inline;
 
214
    function TryApplyStripes: Boolean; inline;
 
215
  public
 
216
    FAxis: TChartBasicAxis;
 
217
    FAxisTransf: TTransformFunc;
 
218
    FClipRangeDelta: Integer;
 
219
    FClipRect: ^TRect;
 
220
    FDrawer: IChartDrawer;
 
221
    FPrevCoord: Integer;
 
222
    FScaledTickLength: Integer;
 
223
    FStripeIndex: Cardinal;
 
224
    FTransf: ICoordTransformer;
 
225
    FValueMax: Double;
 
226
    FValueMin: Double;
 
227
    FZOffset: TPoint;
 
228
 
 
229
    procedure BeginDrawing; virtual;
 
230
    function Clone: TAxisDrawHelper;
 
231
    constructor Create; virtual;
 
232
    procedure DrawAxisLine(
 
233
      APen: TChartPen; AFixedCoord: Integer); virtual; abstract;
 
234
    procedure DrawMark(
 
235
      AFixedCoord: Integer; AMark: Double; const AText: String);
 
236
    procedure EndDrawing; virtual; abstract;
 
237
    procedure GetClipRange(out AMin, AMax: Integer); virtual; abstract;
 
238
    function GraphToImage(AGraph: Double): Integer; virtual; abstract;
 
239
  end;
 
240
 
 
241
  TAxisDrawHelperClass = class of TAxisDrawHelper;
 
242
 
 
243
  { TAxisDrawHelperX }
 
244
 
 
245
  TAxisDrawHelperX = class(TAxisDrawHelper)
 
246
  strict protected
 
247
    procedure DrawLabelAndTick(
 
248
      ACoord, AFixedCoord: Integer; const AText: String); override;
 
249
    procedure GridLine(ACoord: Integer); override;
 
250
  public
 
251
    procedure BeginDrawing; override;
 
252
    procedure DrawAxisLine(APen: TChartPen; AFixedCoord: Integer); override;
 
253
    procedure EndDrawing; override;
 
254
    procedure GetClipRange(out AMin, AMax: Integer); override;
 
255
    function GraphToImage(AGraph: Double): Integer; override;
 
256
  end;
 
257
 
 
258
  { TAxisDrawHelperY }
 
259
 
 
260
  TAxisDrawHelperY = class(TAxisDrawHelper)
 
261
  strict protected
 
262
    procedure DrawLabelAndTick(
 
263
      ACoord, AFixedCoord: Integer; const AText: String); override;
 
264
    procedure GridLine(ACoord: Integer); override;
 
265
  public
 
266
    procedure BeginDrawing; override;
 
267
    procedure DrawAxisLine(APen: TChartPen; AFixedCoord: Integer); override;
 
268
    procedure EndDrawing; override;
 
269
    procedure GetClipRange(out AMin, AMax: Integer); override;
 
270
    function GraphToImage(AGraph: Double): Integer; override;
 
271
  end;
 
272
 
 
273
implementation
 
274
 
 
275
uses
 
276
  Math, SysUtils,
 
277
  TAGeometry, TAMath;
 
278
 
 
279
{ TChartMinorAxisMarks }
 
280
 
 
281
constructor TChartMinorAxisMarks.Create(AOwner: TCustomChart);
 
282
begin
 
283
  inherited Create(AOwner);
 
284
  FStyle := smsNone;
 
285
  FFormat := SERIES_MARK_FORMATS[FStyle];
 
286
end;
 
287
 
 
288
{ TAxisDrawHelper }
 
289
 
 
290
procedure TAxisDrawHelper.BarZ(AX1, AY1, AX2, AY2: Integer);
 
291
begin
 
292
  with FZOffset do
 
293
    FDrawer.FillRect(AX1 + X, AY1 + Y, AX2 + X, AY2 + Y);
 
294
end;
 
295
 
 
296
procedure TAxisDrawHelper.BeginDrawing;
 
297
begin
 
298
  FScaledTickLength := FDrawer.Scale(FAxis.TickLength);
 
299
end;
 
300
 
 
301
function TAxisDrawHelper.Clone: TAxisDrawHelper;
 
302
begin
 
303
  Result := TAxisDrawHelperClass(ClassType).Create;
 
304
  Result.FAxis := FAxis;
 
305
  Result.FAxisTransf := FAxisTransf;
 
306
  Result.FClipRect := FClipRect;
 
307
  Result.FDrawer := FDrawer;
 
308
  Result.FTransf := FTransf;
 
309
  Result.FValueMax := FValueMax;
 
310
  Result.FValueMin := FValueMin;
 
311
  Result.FZOffset := FZOffset;
 
312
end;
 
313
 
 
314
constructor TAxisDrawHelper.Create;
 
315
begin
 
316
  inherited; // Empty -- just to enforce a virtual constructor.
 
317
end;
 
318
 
 
319
procedure TAxisDrawHelper.DrawLabel(ALabelCenter: TPoint; const AText: String);
 
320
begin
 
321
  ALabelCenter += FZOffset;
 
322
  FAxis.Marks.DrawLabel(
 
323
    FDrawer, ALabelCenter, ALabelCenter, AText, FPrevLabelPoly);
 
324
end;
 
325
 
 
326
procedure TAxisDrawHelper.DrawMark(
 
327
  AFixedCoord: Integer; AMark: Double; const AText: String);
 
328
var
 
329
  coord: Integer;
 
330
begin
 
331
  coord := GraphToImage(AMark);
 
332
  if
 
333
    not IsInClipRange(coord) or not InRangeUlps(AMark, FValueMin, FValueMax, 2)
 
334
  then exit;
 
335
 
 
336
  if FAxis.Grid.Visible then begin
 
337
    FDrawer.Pen := FAxis.Grid;
 
338
    FDrawer.SetBrushParams(bsClear, clTAColor);
 
339
    GridLine(coord);
 
340
    FPrevCoord := coord;
 
341
  end;
 
342
 
 
343
  if FAxis.Marks.Visible then begin
 
344
    FDrawer.PrepareSimplePen(FAxis.TickColor);
 
345
    DrawLabelAndTick(coord, AFixedCoord, AText);
 
346
  end;
 
347
end;
 
348
 
 
349
procedure TAxisDrawHelper.InternalAxisLine(
 
350
  APen: TChartPen; const AStart, AEnd: TPoint; AAngle: Double);
 
351
begin
 
352
  if not APen.Visible and not FAxis.Arrow.Visible then exit;
 
353
  FDrawer.Pen := APen;
 
354
  if APen.Visible then
 
355
    LineZ(AStart, AEnd);
 
356
  if FAxis.Arrow.Visible then
 
357
    FAxis.Arrow.Draw(FDrawer, AEnd + FZOffset, AAngle, APen);
 
358
end;
 
359
 
 
360
function TAxisDrawHelper.IsInClipRange(ACoord: Integer): Boolean;
 
361
var
 
362
  rmin, rmax: Integer;
 
363
begin
 
364
  GetClipRange(rmin, rmax);
 
365
  Result := InRange(ACoord, rmin + FClipRangeDelta, rmax - FClipRangeDelta);
 
366
end;
 
367
 
 
368
procedure TAxisDrawHelper.LineZ(AP1, AP2: TPoint);
 
369
begin
 
370
  FDrawer.Line(AP1 + FZOffset, AP2 + FZOffset);
 
371
end;
 
372
 
 
373
function TAxisDrawHelper.TryApplyStripes: Boolean;
 
374
begin
 
375
  Result := FAxis.TryApplyStripes(FDrawer, FStripeIndex);
 
376
end;
 
377
 
 
378
{ TAxisDrawHelperX }
 
379
 
 
380
procedure TAxisDrawHelperX.BeginDrawing;
 
381
begin
 
382
  inherited;
 
383
  FPrevCoord := FClipRect^.Left;
 
384
end;
 
385
 
 
386
procedure TAxisDrawHelperX.DrawAxisLine(APen: TChartPen; AFixedCoord: Integer);
 
387
var
 
388
  p: TPoint;
 
389
begin
 
390
  p := Point(FClipRect^.Right, AFixedCoord);
 
391
  if FAxis.Arrow.Visible then
 
392
    p.X += FDrawer.Scale(FAxis.Arrow.Length);
 
393
  InternalAxisLine(APen, Point(FClipRect^.Left, AFixedCoord), p, 0);
 
394
end;
 
395
 
 
396
procedure TAxisDrawHelperX.DrawLabelAndTick(
 
397
  ACoord, AFixedCoord: Integer; const AText: String);
 
398
var
 
399
  d: Integer;
 
400
begin
 
401
  d := FScaledTickLength + FAxis.Marks.CenterOffset(FDrawer, AText).cy;
 
402
  if FAxis.Alignment = calTop then
 
403
    d := -d;
 
404
  LineZ(
 
405
    Point(ACoord, AFixedCoord - FScaledTickLength),
 
406
    Point(ACoord, AFixedCoord + FScaledTickLength));
 
407
  DrawLabel(Point(ACoord, AFixedCoord + d), AText);
 
408
end;
 
409
 
 
410
procedure TAxisDrawHelperX.EndDrawing;
 
411
begin
 
412
  if FAxis.Grid.Visible and TryApplyStripes then
 
413
    BarZ(FPrevCoord + 1, FClipRect^.Top + 1, FClipRect^.Right, FClipRect^.Bottom);
 
414
end;
 
415
 
 
416
procedure TAxisDrawHelperX.GetClipRange(out AMin, AMax: Integer);
 
417
begin
 
418
  AMin := FClipRect^.Left;
 
419
  AMax := FClipRect^.Right;
 
420
end;
 
421
 
 
422
function TAxisDrawHelperX.GraphToImage(AGraph: Double): Integer;
 
423
begin
 
424
  Result := FTransf.XGraphToImage(AGraph);
 
425
end;
 
426
 
 
427
procedure TAxisDrawHelperX.GridLine(ACoord: Integer);
 
428
begin
 
429
  if TryApplyStripes then
 
430
    BarZ(FPrevCoord + 1, FClipRect^.Top + 1, ACoord, FClipRect^.Bottom);
 
431
  LineZ(Point(ACoord, FClipRect^.Top), Point(ACoord, FClipRect^.Bottom));
 
432
end;
 
433
 
 
434
{ TAxisDrawHelperY }
 
435
 
 
436
procedure TAxisDrawHelperY.BeginDrawing;
 
437
begin
 
438
  inherited;
 
439
  FPrevCoord := FClipRect^.Bottom;
 
440
end;
 
441
 
 
442
procedure TAxisDrawHelperY.DrawAxisLine(APen: TChartPen; AFixedCoord: Integer);
 
443
var
 
444
  p: TPoint;
 
445
begin
 
446
  p := Point(AFixedCoord, FClipRect^.Top);
 
447
  if FAxis.Arrow.Visible then
 
448
    p.Y -= FDrawer.Scale(FAxis.Arrow.Length);
 
449
  InternalAxisLine(APen, Point(AFixedCoord, FClipRect^.Bottom), p, -Pi / 2);
 
450
end;
 
451
 
 
452
procedure TAxisDrawHelperY.DrawLabelAndTick(
 
453
  ACoord, AFixedCoord: Integer; const AText: String);
 
454
var
 
455
  d: Integer;
 
456
begin
 
457
  d := FScaledTickLength + FAxis.Marks.CenterOffset(FDrawer, AText).cx;
 
458
  if FAxis.Alignment = calLeft then
 
459
    d := -d;
 
460
  LineZ(
 
461
    Point(AFixedCoord - FScaledTickLength, ACoord),
 
462
    Point(AFixedCoord + FScaledTickLength, ACoord));
 
463
  DrawLabel(Point(AFixedCoord + d, ACoord), AText);
 
464
end;
 
465
 
 
466
procedure TAxisDrawHelperY.EndDrawing;
 
467
begin
 
468
  if FAxis.Grid.Visible and TryApplyStripes then
 
469
    BarZ(FClipRect^.Left + 1, FClipRect^.Top + 1, FClipRect^.Right, FPrevCoord);
 
470
end;
 
471
 
 
472
procedure TAxisDrawHelperY.GetClipRange(out AMin, AMax: Integer);
 
473
begin
 
474
  AMin := FClipRect^.Top;
 
475
  AMax := FClipRect^.Bottom;
 
476
end;
 
477
 
 
478
function TAxisDrawHelperY.GraphToImage(AGraph: Double): Integer;
 
479
begin
 
480
  Result := FTransf.YGraphToImage(AGraph);
 
481
end;
 
482
 
 
483
procedure TAxisDrawHelperY.GridLine(ACoord: Integer);
 
484
begin
 
485
  if TryApplyStripes then
 
486
    BarZ(FClipRect^.Left + 1, FPrevCoord, FClipRect^.Right, ACoord);
 
487
  LineZ(Point(FClipRect^.Left, ACoord), Point(FClipRect^.Right, ACoord));
 
488
end;
 
489
 
 
490
{ TChartAxisTitle }
 
491
 
 
492
procedure TChartAxisTitle.Assign(Source: TPersistent);
 
493
begin
 
494
  if Source is TChartAxisTitle then
 
495
    with TChartAxisTitle(Source) do begin
 
496
      Self.FLabelBrush.Assign(FLabelBrush);
 
497
      Self.FLabelFont.Assign(FLabelFont);
 
498
      Self.FLinkPen.Assign(FLinkPen);
 
499
      Self.FCaption := FCaption;
 
500
    end;
 
501
  inherited Assign(Source);
 
502
end;
 
503
 
 
504
constructor TChartAxisTitle.Create(AOwner: TCustomChart);
 
505
begin
 
506
  inherited Create(AOwner);
 
507
  FDistance := DEF_TITLE_DISTANCE;
 
508
  FLabelBrush.Style := bsClear;
 
509
  FVisible := false;
 
510
end;
 
511
 
 
512
function TChartAxisTitle.GetFont: TFont;
 
513
begin
 
514
  Result := LabelFont;
 
515
end;
 
516
 
 
517
procedure TChartAxisTitle.SetCaption(AValue: String);
 
518
begin
 
519
  if FCaption = AValue then exit;
 
520
  FCaption := AValue;
 
521
  StyleChanged(Self);
 
522
end;
 
523
 
 
524
procedure TChartAxisTitle.SetFont(AValue: TFont);
 
525
begin
 
526
  LabelFont := AValue;
 
527
end;
 
528
 
 
529
procedure TChartAxisTitle.SetPositionOnMarks(AValue: Boolean);
 
530
begin
 
531
  if FPositionOnMarks = AValue then exit;
 
532
  FPositionOnMarks := AValue;
 
533
  StyleChanged(Self);
 
534
end;
 
535
 
 
536
{ TCustomChartAxisMarks }
 
537
 
 
538
constructor TCustomChartAxisMarks.Create(AOwner: TCustomChart);
 
539
begin
 
540
  inherited Create(AOwner);
 
541
  FDefaultListener := TListener.Create(nil, @StyleChanged);
 
542
  FDefaultSource := TIntervalChartSource.Create(AOwner);
 
543
  FDefaultSource.Broadcaster.Subscribe(FDefaultListener);
 
544
  FDistance := 1;
 
545
  FLabelBrush.Style := bsClear;
 
546
end;
 
547
 
 
548
destructor TCustomChartAxisMarks.Destroy;
 
549
begin
 
550
  FreeAndNil(FDefaultListener);
 
551
  FreeAndNil(FDefaultSource);
 
552
  inherited;
 
553
end;
 
554
 
 
555
function TCustomChartAxisMarks.IsFormatStored: Boolean;
 
556
begin
 
557
  Result := FStyle <> smsValue;
 
558
end;
 
559
 
 
560
function TCustomChartAxisMarks.Measure(ADrawer: IChartDrawer;
 
561
  AIsVertical: Boolean; ATickLength: Integer;
 
562
  AValues: TChartValueTextArray): Integer;
 
563
var
 
564
  t: TChartValueText;
 
565
begin
 
566
  Result := 0;
 
567
  if not Visible then exit;
 
568
  for t in AValues do
 
569
    // Workaround for issue #19780, fix after upgrade to FPC 2.6.
 
570
    with MeasureLabel(ADrawer, t.FText) do
 
571
      Result := Max(IfThen(AIsVertical, cy, cx), Result);
 
572
  if Result = 0 then exit;
 
573
  if DistanceToCenter then
 
574
    Result := Result div 2;
 
575
  Result += ADrawer.Scale(ATickLength) + ADrawer.Scale(Distance);
 
576
end;
 
577
 
 
578
procedure TCustomChartAxisMarks.SetStripes(AValue: TChartStyles);
 
579
begin
 
580
  if FStripes = AValue then exit;
 
581
  FStripes := AValue;
 
582
  StyleChanged(Self);
 
583
end;
 
584
 
 
585
{ TChartAxisMarks }
 
586
 
 
587
constructor TChartAxisMarks.Create(AOwner: TCustomChart);
 
588
begin
 
589
  inherited Create(AOwner);
 
590
  FListener := TListener.Create(@FSource, @StyleChanged);
 
591
  FRange := TChartRange.Create(AOwner);
 
592
  FStyle := smsValue;
 
593
  FFormat := SERIES_MARK_FORMATS[FStyle];
 
594
end;
 
595
 
 
596
destructor TChartAxisMarks.Destroy;
 
597
begin
 
598
  FreeAndNil(FRange);
 
599
  FreeAndNil(FListener);
 
600
  inherited;
 
601
end;
 
602
 
 
603
procedure TChartAxisMarks.SetAtDataOnly(AValue: Boolean);
 
604
begin
 
605
  if FAtDataOnly = AValue then exit;
 
606
  FAtDataOnly := AValue;
 
607
  StyleChanged(Self);
 
608
end;
 
609
 
 
610
procedure TChartAxisMarks.SetRange(AValue: TChartRange);
 
611
begin
 
612
  if FRange = AValue then exit;
 
613
  FRange.Assign(AValue);
 
614
  StyleChanged(Self);
 
615
end;
 
616
 
 
617
procedure TChartAxisMarks.SetSource(AValue: TCustomChartSource);
 
618
begin
 
619
  if FSource = AValue then exit;
 
620
  if FListener.IsListening then
 
621
    FSource.Broadcaster.Unsubscribe(FListener);
 
622
  FSource := AValue;
 
623
  if FSource <> nil then
 
624
    FSource.Broadcaster.Subscribe(FListener);
 
625
  StyleChanged(Self);
 
626
end;
 
627
 
 
628
function TChartAxisMarks.SourceDef: TCustomChartSource;
 
629
begin
 
630
  Result := FSource;
 
631
  if Result = nil then
 
632
    Result := DefaultSource;
 
633
end;
 
634
 
 
635
{ TChartBasicAxis }
 
636
 
 
637
procedure TChartBasicAxis.Assign(ASource: TPersistent);
 
638
begin
 
639
  if ASource is TChartBasicAxis then
 
640
    with TChartBasicAxis(ASource) do begin
 
641
      Self.FGrid.Assign(Grid);
 
642
      Self.FMarks.Assign(Marks);
 
643
      Self.FTickColor := TickColor;
 
644
      Self.FTickLength := TickLength;
 
645
      Self.FVisible := Visible;
 
646
    end
 
647
  else
 
648
    inherited Assign(ASource);
 
649
end;
 
650
 
 
651
constructor TChartBasicAxis.Create(
 
652
  ACollection: TCollection; AChart: TCustomChart);
 
653
begin
 
654
  inherited Create(ACollection);
 
655
  FArrow := TChartArrow.Create(AChart);
 
656
  FGrid := TChartAxisGridPen.Create;
 
657
  FGrid.OnChange := @StyleChanged;
 
658
  // FMarks must be created in descendants.
 
659
  FTickColor := clBlack;
 
660
  FVisible := true;
 
661
end;
 
662
 
 
663
destructor TChartBasicAxis.Destroy;
 
664
begin
 
665
  FreeAndNil(FArrow);
 
666
  FreeAndNil(FGrid);
 
667
  FreeAndNil(FMarks);
 
668
  inherited;
 
669
end;
 
670
 
 
671
function TChartBasicAxis.GetIntervals: TChartAxisIntervalParams;
 
672
begin
 
673
  Result := Marks.DefaultSource.Params;
 
674
end;
 
675
 
 
676
procedure TChartBasicAxis.SetArrow(AValue: TChartArrow);
 
677
begin
 
678
  FArrow.Assign(AValue);
 
679
  StyleChanged(Self);
 
680
end;
 
681
 
 
682
procedure TChartBasicAxis.SetGrid(AValue: TChartAxisGridPen);
 
683
begin
 
684
  FGrid.Assign(AValue);
 
685
  StyleChanged(Self);
 
686
end;
 
687
 
 
688
procedure TChartBasicAxis.SetIntervals(AValue: TChartAxisIntervalParams);
 
689
begin
 
690
  Marks.DefaultSource.Params := AValue;
 
691
end;
 
692
 
 
693
procedure TChartBasicAxis.SetMarks(AValue: TCustomChartAxisMarks);
 
694
begin
 
695
  FMarks.Assign(AValue);
 
696
  StyleChanged(Self);
 
697
end;
 
698
 
 
699
procedure TChartBasicAxis.SetTickColor(AValue: TColor);
 
700
begin
 
701
  if FTickColor = AValue then exit;
 
702
  FTickColor := AValue;
 
703
  StyleChanged(Self);
 
704
end;
 
705
 
 
706
procedure TChartBasicAxis.SetTickLength(AValue: Integer);
 
707
begin
 
708
  if FTickLength = AValue then exit;
 
709
  FTickLength := AValue;
 
710
  StyleChanged(Self);
 
711
end;
 
712
 
 
713
procedure TChartBasicAxis.SetVisible(AValue: Boolean);
 
714
begin
 
715
  if FVisible = AValue then exit;
 
716
  FVisible := AValue;
 
717
  StyleChanged(Self);
 
718
end;
 
719
 
 
720
function TChartBasicAxis.TryApplyStripes(
 
721
  ADrawer: IChartDrawer; var AIndex: Cardinal): Boolean;
 
722
begin
 
723
  Result := Marks.Stripes <> nil;
 
724
  if not Result then exit;
 
725
  Marks.Stripes.Apply(ADrawer, AIndex);
 
726
  AIndex += 1;
 
727
end;
 
728
 
 
729
end.