File: tachartteechart.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (213 lines) | stat: -rw-r--r-- 5,664 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
{
 *****************************************************************************
  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************

  TeeChart compatibility.

  Authors: Alexander Klenin

}
unit TAChartTeeChart;

{$H+}

interface

uses
  Classes, SysUtils,
  TAGraph, TAChartAxis, TAChartAxisUtils, TAChartUtils, TACustomSeries,
  TASeries, TATransformations;

type
  TChartTeeChart = class helper for TChart
  strict private
    // Workaround for issue #21809.
    function GetAxisByAlign1(AIndex: TChartAxisAlignment): TChartAxis; inline;
    function GetMargin(AIndex: Integer): Integer; inline;
    procedure SetMargin(AIndex: Integer; AValue: TChartDistance); inline;
  public
    property RightAxis: TChartAxis index calRight read GetAxisByAlign1;
    property TopAxis: TChartAxis index calTop read GetAxisByAlign1;
  public
    property MarginBottom: TChartDistance index 4 read GetMargin write SetMargin;
    property MarginLeft: TChartDistance index 1 read GetMargin write SetMargin;
    property MarginRight: TChartDistance index 3 read GetMargin write SetMargin;
    property MarginTop: TChartDistance index 2 read GetMargin write SetMargin;
  end;

  TPointSeries = class(TLineSeries)
  published
    property LineType default ltNone;
    property ShowPoints default true;
  end;

  THorizBarSeries = class(TBarSeries)
  public
    // Swap X and Y as TeeChart does.
    function AddXY(
      AX, AY: Double; AXLabel: String = '';
      AColor: TChartColor = clTAColor): Integer; overload; inline;
    constructor Create(AOwner: TComponent); override;
  published
    property AxisIndexX default 0;
    property AxisIndexY default 1;
  end;

  TChartSeriesStyle = set of (
    tssIsTemplate, tssDenyChangeType, tssDenyDelete, tssDenyClone,
    tssIsPersistent, tssHideDataSource);

  TCustomChartSeriesTeeChart = class helper for TCustomChartSeries
  strict private
    function GetStyle: TChartSeriesStyle; inline;
    procedure SetStyle(AValue: TChartSeriesStyle); inline;
  published
    // Does not do anything, just avoid IFDEFs in client code.
    property Style: TChartSeriesStyle read GetStyle write SetStyle default [];
  end;

  TChartAxisTeeChart = class helper for TChartAxis
  strict private
    function GetLogarithmic: Boolean;
    procedure SetLogarithmic(AValue: Boolean);
  published
    property Logarithmic: Boolean
      read GetLogarithmic write SetLogarithmic default false;
  end;

implementation

uses
  Math;

type
  TLogTransformEnumerator = class(TAxisTransformEnumerator)
    function GetCurrent: TLogarithmAxisTransform;
    function MoveNext: Boolean;
    property Current: TLogarithmAxisTransform read GetCurrent;
    function GetEnumerator: TLogTransformEnumerator;
  end;

var
  VLogTransforms: array of TChartAxisTransformations;

function AddLogTransforms: TChartAxisTransformations;
begin
  Result := TChartAxisTransformations.Create(nil);
  TLogarithmAxisTransform.Create(nil).Transformations := Result;
  SetLength(VLogTransforms, Length(VLogTransforms) + 1);
  VLogTransforms[High(VLogTransforms)] := Result;
end;

procedure FreeLogTransforms;
var
  t: TChartAxisTransformations;
begin
  for t in VLogTransforms do
    t.Free;
  VLogTransforms := nil;
end;

{ TLogTransformEnumerator }

function TLogTransformEnumerator.GetCurrent: TLogarithmAxisTransform;
begin
  Result := inherited GetCurrent as TLogarithmAxisTransform;
end;

function TLogTransformEnumerator.GetEnumerator: TLogTransformEnumerator;
begin
  Result := Self;
end;

function TLogTransformEnumerator.MoveNext: Boolean;
begin
  repeat
    Result := inherited MoveNext;
  until Result and (inherited GetCurrent is TLogarithmAxisTransform);
end;

{ TChartAxisTeeChart }

function TChartAxisTeeChart.GetLogarithmic: Boolean;
var
  t: TLogarithmAxisTransform;
begin
  if Transformations <> nil then
    for t in TLogTransformEnumerator.Create(Transformations.List) do
      if t.Enabled then
        exit(true);
  Result := false;
end;

procedure TChartAxisTeeChart.SetLogarithmic(AValue: Boolean);
var
  t: TLogarithmAxisTransform;
begin
  Intervals.Tolerance := IfThen(AValue, 2, 0);
  if Transformations <> nil then
    for t in TLogTransformEnumerator.Create(Transformations.List) do
      t.Enabled := AValue
  else if AValue then
    Transformations := AddLogTransforms;
end;

{ TCustomChartSeriesTeeChart }

function TCustomChartSeriesTeeChart.GetStyle: TChartSeriesStyle;
begin
  Result := [];
end;

procedure TCustomChartSeriesTeeChart.SetStyle(AValue: TChartSeriesStyle);
begin
  Unused(AValue);
end;

{ THorizBarSeries }

function THorizBarSeries.AddXY(
  AX, AY: Double; AXLabel: String; AColor: TChartColor): Integer;
begin
  Result := inherited AddXY(AY, AX, AXLabel, AColor);
end{%H-};  // to silence the compiler warning of impossible inline of inherited method

constructor THorizBarSeries.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetPropDefaults(Self, ['AxisIndexX', 'AxisIndexY']);
end;

{ TChartTeeChart }

function TChartTeeChart.GetAxisByAlign1(AIndex: TChartAxisAlignment): TChartAxis;
begin
  // Using "inherited" here results in a crash, probably due to FPC bug.
  Result := GetAxisByAlign(AIndex);
end;

function TChartTeeChart.GetMargin(AIndex: Integer): Integer;
begin
  Result := Margins.GetValue(AIndex);
end;

procedure TChartTeeChart.SetMargin(AIndex: Integer; AValue: TChartDistance);
begin
  Margins.SetValue(AIndex, AValue);
end;

procedure Dummy;
begin
  // Workaround for issue #21808.
end;

initialization
  Dummy;

finalization
  FreeLogTransforms;

end.