← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/tachart/tamultiseries.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/tamultiseries.pas
22
22
 
23
23
uses
24
24
  Classes, Graphics,
25
 
  TAChartUtils, TACustomSeries, TALegend;
 
25
  TAChartUtils, TACustomSeries, TADrawUtils, TALegend;
26
26
 
27
27
const
28
28
  DEF_BOX_WIDTH = 50;
29
29
  DEF_WHISKERS_WIDTH = 25;
 
30
  DEF_OHLC_TICK_WIDTH = 25;
 
31
  DEF_YINDEX_OPEN = 1;
 
32
  DEF_YINDEX_HIGH = 3;
 
33
  DEF_YINDEX_LOW = 0;
 
34
  DEF_YINDEX_CLOSE = 2;
30
35
 
31
36
type
32
37
 
44
49
    procedure GetLegendItems(AItems: TChartLegendItems); override;
45
50
    function GetSeriesColor: TColor; override;
46
51
  public
 
52
    procedure Assign(ASource: TPersistent); override;
47
53
    constructor Create(AOwner: TComponent); override;
48
54
    destructor  Destroy; override;
49
55
 
50
 
    procedure Draw(ACanvas: TCanvas); override;
 
56
    procedure Draw(ADrawer: IChartDrawer); override;
51
57
    function Extent: TDoubleRect; override;
52
58
  published
53
59
    property AxisIndexX;
77
83
    procedure GetLegendItems(AItems: TChartLegendItems); override;
78
84
    function GetSeriesColor: TColor; override;
79
85
  public
 
86
    function AddXY(
 
87
      AX, AYLoWhisker, AYLoBox, AY, AYHiBox, AYHiWhisker: Double;
 
88
      AXLabel: String = ''; AColor: TColor = clTAColor): Integer; overload;
 
89
    procedure Assign(ASource: TPersistent); override;
80
90
    constructor Create(AOwner: TComponent); override;
81
91
    destructor  Destroy; override;
82
92
 
83
 
    procedure Draw(ACanvas: TCanvas); override;
 
93
    procedure Draw(ADrawer: IChartDrawer); override;
84
94
    function Extent: TDoubleRect; override;
85
95
  published
86
96
    property BoxBrush: TBrush read FBoxBrush write SetBoxBrush;
97
107
    property Source;
98
108
  end;
99
109
 
 
110
  { TOpenHighLowCloseSeries }
 
111
 
 
112
  TOpenHighLowCloseSeries = class(TBasicPointSeries)
 
113
  private
 
114
    FLinePen: TPen;
 
115
    FTickWidth: Cardinal;
 
116
    FYIndexClose: Cardinal;
 
117
    FYIndexHigh: Cardinal;
 
118
    FYIndexLow: Cardinal;
 
119
    FYIndexOpen: Cardinal;
 
120
    procedure SetLinePen(AValue: TPen);
 
121
    procedure SetTickWidth(AValue: Cardinal);
 
122
    procedure SetYIndexClose(AValue: Cardinal);
 
123
    procedure SetYIndexHigh(AValue: Cardinal);
 
124
    procedure SetYIndexLow(AValue: Cardinal);
 
125
    procedure SetYIndexOpen(AValue: Cardinal);
 
126
  protected
 
127
    procedure GetLegendItems(AItems: TChartLegendItems); override;
 
128
    function GetSeriesColor: TColor; override;
 
129
  public
 
130
    procedure Assign(ASource: TPersistent); override;
 
131
    constructor Create(AOwner: TComponent); override;
 
132
    destructor  Destroy; override;
 
133
 
 
134
    procedure Draw(ADrawer: IChartDrawer); override;
 
135
    function Extent: TDoubleRect; override;
 
136
  published
 
137
    property LinePen: TPen read FLinePen write SetLinePen;
 
138
    property TickWidth: Cardinal
 
139
      read FTickWidth write SetTickWidth default DEF_OHLC_TICK_WIDTH;
 
140
    property YIndexClose: Cardinal
 
141
      read FYIndexClose write SetYIndexClose default DEF_YINDEX_CLOSE;
 
142
    property YIndexHigh: Cardinal
 
143
      read FYIndexHigh write SetYIndexHigh default DEF_YINDEX_HIGH;
 
144
    property YIndexLow: Cardinal
 
145
      read FYIndexLow write SetYIndexLow default DEF_YINDEX_LOW;
 
146
    property YIndexOpen: Cardinal
 
147
      read FYIndexOpen write SetYIndexOpen default DEF_YINDEX_OPEN;
 
148
  published
 
149
    property AxisIndexX;
 
150
    property AxisIndexY;
 
151
    property Source;
 
152
  end;
 
153
 
100
154
implementation
101
155
 
102
156
uses
103
 
  Math, SysUtils, TAGraph;
 
157
  Math, SysUtils, TAGeometry, TAGraph, TAMath;
 
158
 
 
159
type
 
160
 
 
161
  { TLegendItemOHLCLine }
 
162
 
 
163
  TLegendItemOHLCLine = class(TLegendItemLine)
 
164
  public
 
165
    procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
 
166
  end;
 
167
 
 
168
{ TLegendItemOHLCLine }
 
169
 
 
170
procedure TLegendItemOHLCLine.Draw(ADrawer: IChartDrawer; const ARect: TRect);
 
171
var
 
172
  dx, x, y: Integer;
 
173
begin
 
174
  inherited Draw(ADrawer, ARect);
 
175
  y := (ARect.Top + ARect.Bottom) div 2;
 
176
  dx := (ARect.Right - ARect.Left) div 3;
 
177
  x := ARect.Left + dx;
 
178
  ADrawer.Line(x, y, x, y + 2);
 
179
  x += dx;
 
180
  ADrawer.Line(x, y, x, y - 2);
 
181
end;
104
182
 
105
183
{ TBubbleSeries }
106
184
 
 
185
procedure TBubbleSeries.Assign(ASource: TPersistent);
 
186
begin
 
187
  if ASource is TBubbleSeries then
 
188
    with TBubbleSeries(ASource) do begin
 
189
      Self.BubbleBrush := FBubbleBrush;
 
190
      Self.BubblePen := FBubblePen;
 
191
    end;
 
192
  inherited Assign(ASource);
 
193
end;
 
194
 
107
195
constructor TBubbleSeries.Create(AOwner: TComponent);
108
196
begin
109
197
  inherited Create(AOwner);
120
208
  inherited Destroy;
121
209
end;
122
210
 
123
 
procedure TBubbleSeries.Draw(ACanvas: TCanvas);
 
211
procedure TBubbleSeries.Draw(ADrawer: IChartDrawer);
124
212
var
125
213
  i: Integer;
126
214
  pt, d: TPoint;
132
220
    r := Max(Source[i]^.YList[0], r);
133
221
  with ParentChart.CurrentExtent do
134
222
    PrepareGraphPoints(DoubleRect(a.X - r, a.Y - r, b.X + r, b.Y + r), true);
135
 
  ACanvas.Pen.Assign(BubblePen);
136
 
  ACanvas.Brush.Assign(BubbleBrush);
 
223
  ADrawer.Pen := BubblePen;
 
224
  ADrawer.Brush := BubbleBrush;
137
225
  for i := 0 to High(FGraphPoints) do begin
138
226
    pt := ParentChart.GraphToImage(FGraphPoints[i]);
139
227
    r := Source[i + FLoBound]^.YList[0];
140
228
    d.X := ParentChart.XGraphToImage(r) - ParentChart.XGraphToImage(0);
141
229
    d.Y := ParentChart.YGraphToImage(r) - ParentChart.YGraphToImage(0);
142
 
    ACanvas.EllipseC(pt.X, pt.Y, d.X, d.Y);
 
230
    ADrawer.Ellipse(pt.X - d.X, pt.Y - d.Y, pt.X + d.X, pt.Y + d.Y);
143
231
  end;
144
 
  DrawLabels(ACanvas);
 
232
  DrawLabels(ADrawer);
145
233
end;
146
234
 
147
235
function TBubbleSeries.Extent: TDoubleRect;
187
275
 
188
276
{ TBoxAndWhiskerSeries }
189
277
 
 
278
function TBoxAndWhiskerSeries.AddXY(
 
279
  AX, AYLoWhisker, AYLoBox, AY, AYHiBox, AYHiWhisker: Double; AXLabel: String;
 
280
  AColor: TColor): Integer;
 
281
begin
 
282
  Result := AddXY(
 
283
    AX, AYLoWhisker, [AYLoBox, AY, AYHiBox, AYHiWhisker], AXLabel, AColor);
 
284
end;
 
285
 
 
286
procedure TBoxAndWhiskerSeries.Assign(ASource: TPersistent);
 
287
begin
 
288
  if ASource is TBoxAndWhiskerSeries then
 
289
    with TBoxAndWhiskerSeries(ASource) do begin
 
290
      Self.BoxBrush.Assign(FBoxBrush);
 
291
      Self.BoxPen.Assign(FBoxPen);
 
292
      Self.FBoxWidth := FBoxWidth;
 
293
      Self.MedianPen.Assign(FMedianPen);
 
294
      Self.WhiskersPen.Assign(FWhiskersPen);
 
295
      Self.FWhiskersWidth := FWhiskersWidth;
 
296
    end;
 
297
  inherited Assign(ASource);
 
298
end;
 
299
 
190
300
constructor TBoxAndWhiskerSeries.Create(AOwner: TComponent);
191
301
begin
192
302
  inherited Create(AOwner);
204
314
 
205
315
destructor TBoxAndWhiskerSeries.Destroy;
206
316
begin
207
 
  inherited Destroy;
208
317
  FreeAndNil(FBoxBrush);
209
318
  FreeAndNil(FBoxPen);
210
319
  FreeAndNil(FMedianPen);
211
320
  FreeAndNil(FWhiskersPen);
 
321
  inherited Destroy;
212
322
end;
213
323
 
214
 
procedure TBoxAndWhiskerSeries.Draw(ACanvas: TCanvas);
 
324
procedure TBoxAndWhiskerSeries.Draw(ADrawer: IChartDrawer);
215
325
 
216
326
  function MaybeRotate(AX, AY: Double): TPoint;
217
327
  begin
222
332
 
223
333
  procedure DoLine(AX1, AY1, AX2, AY2: Double);
224
334
  begin
225
 
    ACanvas.Line(MaybeRotate(AX1, AY1), MaybeRotate(AX2, AY2));
 
335
    ADrawer.Line(MaybeRotate(AX1, AY1), MaybeRotate(AX2, AY2));
226
336
  end;
227
337
 
228
338
  procedure DoRect(AX1, AY1, AX2, AY2: Double);
233
343
      r.TopLeft := MaybeRotate(AX1, AY1);
234
344
      r.BottomRight := MaybeRotate(AX2, AY2);
235
345
    end;
236
 
    ACanvas.Rectangle(r);
 
346
    ADrawer.Rectangle(r);
237
347
  end;
238
348
 
239
349
var
262
372
    wb := w * BoxWidth;
263
373
    ww := w * WhiskersWidth;
264
374
 
265
 
    ACanvas.Pen := WhiskersPen;
266
 
    ACanvas.Brush.Style := bsClear;
 
375
    ADrawer.Pen := WhiskersPen;
 
376
    ADrawer.SetBrushParams(bsClear, clTAColor);
267
377
    DoLine(x - ww, ymin, x + ww, ymin);
268
378
    DoLine(x, ymin, x, yqmin);
269
379
    DoLine(x - ww, ymax, x + ww, ymax);
270
380
    DoLine(x, ymax, x, yqmax);
271
 
    ACanvas.Pen := BoxPen;
272
 
    ACanvas.Brush:= BoxBrush;
 
381
    ADrawer.Pen := BoxPen;
 
382
    ADrawer.Brush:= BoxBrush;
273
383
    DoRect(x - wb, yqmin, x + wb, yqmax);
274
 
    ACanvas.Pen := MedianPen;
275
 
    ACanvas.Brush.Style := bsClear;
 
384
    ADrawer.Pen := MedianPen;
 
385
    ADrawer.SetBrushParams(bsClear, clTAColor);
276
386
    DoLine(x - wb, ymed, x + wb, ymed);
277
387
  end;
278
388
end;
348
458
  UpdateParentChart;
349
459
end;
350
460
 
 
461
{ TOpenHighLowCloseSeries }
 
462
 
 
463
procedure TOpenHighLowCloseSeries.Assign(ASource: TPersistent);
 
464
begin
 
465
  if ASource is TOpenHighLowCloseSeries then
 
466
    with TOpenHighLowCloseSeries(ASource) do begin
 
467
      Self.LinePen := FLinePen;
 
468
      Self.FTickWidth := FTickWidth;
 
469
      Self.FYIndexClose := FYIndexClose;
 
470
      Self.FYIndexHigh := FYIndexHigh;
 
471
      Self.FYIndexLow := FYIndexLow;
 
472
      Self.FYIndexOpen := FYIndexOpen;
 
473
    end;
 
474
  inherited Assign(ASource);
 
475
end;
 
476
 
 
477
constructor TOpenHighLowCloseSeries.Create(AOwner: TComponent);
 
478
begin
 
479
  inherited Create(AOwner);
 
480
  FLinePen := TPen.Create;
 
481
  FLinePen.OnChange := @StyleChanged;
 
482
  FTickWidth := DEF_OHLC_TICK_WIDTH;
 
483
  FYIndexOpen := DEF_YINDEX_OPEN;
 
484
  FYIndexLow := DEF_YINDEX_LOW;
 
485
  FYIndexHigh := DEF_YINDEX_HIGH;
 
486
  FYIndexClose := DEF_YINDEX_CLOSE;
 
487
end;
 
488
 
 
489
destructor TOpenHighLowCloseSeries.Destroy;
 
490
begin
 
491
  FreeAndNil(FLinePen);
 
492
  inherited Destroy;
 
493
end;
 
494
 
 
495
procedure TOpenHighLowCloseSeries.Draw(ADrawer: IChartDrawer);
 
496
 
 
497
  function MaybeRotate(AX, AY: Double): TPoint;
 
498
  begin
 
499
    if IsRotated then
 
500
      Exchange(AX, AY);
 
501
    Result := ParentChart.GraphToImage(DoublePoint(AX, AY));
 
502
  end;
 
503
 
 
504
  procedure DoLine(AX1, AY1, AX2, AY2: Double);
 
505
  begin
 
506
    ADrawer.Line(MaybeRotate(AX1, AY1), MaybeRotate(AX2, AY2));
 
507
  end;
 
508
 
 
509
  function GetGraphPointYIndex(AIndex, AYIndex: Integer): Double;
 
510
  begin
 
511
    if AYIndex = 0 then
 
512
      Result := GetGraphPointY(AIndex)
 
513
    else
 
514
      Result := AxisToGraphY(Source[AIndex]^.YList[AYIndex - 1]);
 
515
  end;
 
516
 
 
517
var
 
518
  my: Cardinal;
 
519
  ext2: TDoubleRect;
 
520
  i: Integer;
 
521
  x, tw, yopen, yhigh, ylow, yclose: Double;
 
522
begin
 
523
  my := MaxIntValue([YIndexOpen, YIndexHigh, YIndexLow, YIndexClose]);
 
524
  if IsEmpty or (my >= Source.YCount) then exit;
 
525
 
 
526
  ext2 := ParentChart.CurrentExtent;
 
527
  ExpandRange(ext2.a.X, ext2.b.X, 1.0);
 
528
  ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
 
529
 
 
530
  PrepareGraphPoints(ext2, true);
 
531
 
 
532
  for i := FLoBound to FUpBound do begin
 
533
    x := GetGraphPointX(i);
 
534
    yopen := GetGraphPointYIndex(i, YIndexOpen);
 
535
    yhigh := GetGraphPointYIndex(i, YIndexHigh);
 
536
    ylow := GetGraphPointYIndex(i, YIndexLow);
 
537
    yclose := GetGraphPointYIndex(i, YIndexClose);
 
538
    tw := GetXRange(x, i) * PERCENT * TickWidth;
 
539
 
 
540
    ADrawer.Pen := LinePen;
 
541
    DoLine(x, yhigh, x, ylow);
 
542
    DoLine(x - tw, yopen, x, yopen);
 
543
    DoLine(x, yclose, x + tw, yclose);
 
544
  end;
 
545
end;
 
546
 
 
547
function TOpenHighLowCloseSeries.Extent: TDoubleRect;
 
548
begin
 
549
  Result := Source.ExtentList;
 
550
end;
 
551
 
 
552
procedure TOpenHighLowCloseSeries.GetLegendItems(AItems: TChartLegendItems);
 
553
begin
 
554
  AItems.Add(TLegendItemOHLCLine.Create(LinePen, LegendTextSingle));
 
555
end;
 
556
 
 
557
function TOpenHighLowCloseSeries.GetSeriesColor: TColor;
 
558
begin
 
559
  Result := LinePen.Color;
 
560
end;
 
561
 
 
562
procedure TOpenHighLowCloseSeries.SetLinePen(AValue: TPen);
 
563
begin
 
564
  if FLinePen = AValue then exit;
 
565
  FLinePen := AValue;
 
566
  UpdateParentChart;
 
567
end;
 
568
 
 
569
procedure TOpenHighLowCloseSeries.SetTickWidth(AValue: Cardinal);
 
570
begin
 
571
  if FTickWidth = AValue then exit;
 
572
  FTickWidth := AValue;
 
573
  UpdateParentChart;
 
574
end;
 
575
 
 
576
procedure TOpenHighLowCloseSeries.SetYIndexClose(AValue: Cardinal);
 
577
begin
 
578
  if FYIndexClose = AValue then exit;
 
579
  FYIndexClose := AValue;
 
580
  UpdateParentChart;
 
581
end;
 
582
 
 
583
procedure TOpenHighLowCloseSeries.SetYIndexHigh(AValue: Cardinal);
 
584
begin
 
585
  if FYIndexHigh = AValue then exit;
 
586
  FYIndexHigh := AValue;
 
587
  UpdateParentChart;
 
588
end;
 
589
 
 
590
procedure TOpenHighLowCloseSeries.SetYIndexLow(AValue: Cardinal);
 
591
begin
 
592
  if FYIndexLow = AValue then exit;
 
593
  FYIndexLow := AValue;
 
594
  UpdateParentChart;
 
595
end;
 
596
 
 
597
procedure TOpenHighLowCloseSeries.SetYIndexOpen(AValue: Cardinal);
 
598
begin
 
599
  if FYIndexOpen = AValue then exit;
 
600
  FYIndexOpen := AValue;
 
601
  UpdateParentChart;
 
602
end;
 
603
 
351
604
initialization
352
605
  RegisterSeriesClass(TBubbleSeries, 'Bubble series');
353
606
  RegisterSeriesClass(TBoxAndWhiskerSeries, 'Box-and-whiskers series');
 
607
  RegisterSeriesClass(TOpenHighLowCloseSeries, 'Open-high-low-close series');
354
608
 
355
609
end.