mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 05:29:26 +02:00
TAChart: Add new series type TFieldSeries. Add sheet "field" in demo "multi".
git-svn-id: trunk@51757 -
This commit is contained in:
wp
parent
5d6a59cbb4
commit
53d48e17bf
@ -8,23 +8,23 @@ object Form1: TForm1
|
||||
ClientWidth = 529
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.1'
|
||||
LCLVersion = '1.7'
|
||||
object PageControl1: TPageControl
|
||||
Left = 0
|
||||
Height = 459
|
||||
Top = 0
|
||||
Width = 529
|
||||
ActivePage = tsBubble
|
||||
ActivePage = tsField
|
||||
Align = alClient
|
||||
TabIndex = 0
|
||||
TabIndex = 4
|
||||
TabOrder = 0
|
||||
object tsBubble: TTabSheet
|
||||
Caption = 'Bubble'
|
||||
ClientHeight = 433
|
||||
ClientHeight = 431
|
||||
ClientWidth = 521
|
||||
object chBubble: TChart
|
||||
Left = 0
|
||||
Height = 433
|
||||
Height = 431
|
||||
Top = 0
|
||||
Width = 521
|
||||
AxisList = <
|
||||
@ -49,7 +49,6 @@ object Form1: TForm1
|
||||
'TAChart'
|
||||
)
|
||||
Align = alClient
|
||||
ParentColor = False
|
||||
object Chart1BubbleSeries1: TBubbleSeries
|
||||
Marks.Attachment = maCenter
|
||||
Marks.Distance = 0
|
||||
@ -64,11 +63,11 @@ object Form1: TForm1
|
||||
end
|
||||
object tsStacked: TTabSheet
|
||||
Caption = 'Stacked'
|
||||
ClientHeight = 433
|
||||
ClientHeight = 431
|
||||
ClientWidth = 521
|
||||
object chStacked: TChart
|
||||
Left = 0
|
||||
Height = 391
|
||||
Height = 389
|
||||
Top = 0
|
||||
Width = 521
|
||||
AxisList = <
|
||||
@ -94,7 +93,6 @@ object Form1: TForm1
|
||||
'TAChart'
|
||||
)
|
||||
Align = alClient
|
||||
ParentColor = False
|
||||
object chStackedBarSeries1: TBarSeries
|
||||
Legend.GroupIndex = 0
|
||||
Legend.Multiplicity = lmStyle
|
||||
@ -145,7 +143,7 @@ object Form1: TForm1
|
||||
object pnStackedControls: TPanel
|
||||
Left = 0
|
||||
Height = 42
|
||||
Top = 391
|
||||
Top = 389
|
||||
Width = 521
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
@ -169,7 +167,7 @@ object Form1: TForm1
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 3
|
||||
ClientHeight = 24
|
||||
ClientHeight = 22
|
||||
ClientWidth = 177
|
||||
Columns = 3
|
||||
ItemIndex = 0
|
||||
@ -183,9 +181,9 @@ object Form1: TForm1
|
||||
end
|
||||
object cbPercentage: TCheckBox
|
||||
Left = 192
|
||||
Height = 17
|
||||
Height = 19
|
||||
Top = 15
|
||||
Width = 75
|
||||
Width = 79
|
||||
Caption = 'Percentage'
|
||||
OnChange = cbPercentageChange
|
||||
TabOrder = 1
|
||||
@ -206,7 +204,7 @@ object Form1: TForm1
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 3
|
||||
ClientHeight = 24
|
||||
ClientHeight = 22
|
||||
ClientWidth = 220
|
||||
Columns = 3
|
||||
Items.Strings = (
|
||||
@ -224,11 +222,11 @@ object Form1: TForm1
|
||||
end
|
||||
object tsWhiskers: TTabSheet
|
||||
Caption = 'Box-and-whiskers'
|
||||
ClientHeight = 433
|
||||
ClientHeight = 431
|
||||
ClientWidth = 521
|
||||
object chWhiskers: TChart
|
||||
Left = 0
|
||||
Height = 433
|
||||
Height = 431
|
||||
Top = 0
|
||||
Width = 521
|
||||
AxisList = <
|
||||
@ -251,7 +249,6 @@ object Form1: TForm1
|
||||
'TAChart'
|
||||
)
|
||||
Align = alClient
|
||||
ParentColor = False
|
||||
object chWhiskersBoxAndWhiskerSeries1: TBoxAndWhiskerSeries
|
||||
Title = 't1'
|
||||
BoxBrush.Color = clGreen
|
||||
@ -264,11 +261,11 @@ object Form1: TForm1
|
||||
end
|
||||
object tsOHLC: TTabSheet
|
||||
Caption = 'OHLC'
|
||||
ClientHeight = 433
|
||||
ClientHeight = 431
|
||||
ClientWidth = 521
|
||||
object chOHLC: TChart
|
||||
Left = 0
|
||||
Height = 433
|
||||
Height = 431
|
||||
Top = 0
|
||||
Width = 521
|
||||
AxisList = <
|
||||
@ -297,19 +294,113 @@ object Form1: TForm1
|
||||
Title.Visible = True
|
||||
Align = alClient
|
||||
Color = clSkyBlue
|
||||
ParentColor = False
|
||||
object chOHLCOpenHighLowCloseSeries1: TOpenHighLowCloseSeries
|
||||
Title = 'test'
|
||||
CandlestickDownBrush.Color = clRed
|
||||
CandlestickUpBrush.Color = clLime
|
||||
DownLinePen.Color = clRed
|
||||
DownLinePen.EndCap = pecSquare
|
||||
DownLinePen.Width = 2
|
||||
LinePen.Color = clBlue
|
||||
LinePen.EndCap = pecSquare
|
||||
LinePen.Width = 2
|
||||
Mode = mOHLC
|
||||
TickWidth = 30
|
||||
end
|
||||
end
|
||||
end
|
||||
object tsField: TTabSheet
|
||||
Caption = 'Field'
|
||||
ClientHeight = 431
|
||||
ClientWidth = 521
|
||||
object chField: TChart
|
||||
Left = 0
|
||||
Height = 397
|
||||
Top = 0
|
||||
Width = 521
|
||||
AxisList = <
|
||||
item
|
||||
Grid.Visible = False
|
||||
Minors = <>
|
||||
Title.LabelFont.Orientation = 900
|
||||
end
|
||||
item
|
||||
Grid.Visible = False
|
||||
Alignment = calBottom
|
||||
Minors = <>
|
||||
end>
|
||||
BackColor = clWhite
|
||||
Foot.Brush.Color = clBtnFace
|
||||
Foot.Font.Color = clBlue
|
||||
Legend.Visible = True
|
||||
Title.Brush.Color = clBtnFace
|
||||
Title.Font.Color = clBlue
|
||||
Title.Text.Strings = (
|
||||
'TAChart'
|
||||
)
|
||||
Align = alClient
|
||||
object chFieldFieldSeries1: TFieldSeries
|
||||
Title = 'Vector field'
|
||||
Arrow.BaseLength = 30
|
||||
Arrow.Length = 40
|
||||
Arrow.Visible = True
|
||||
Arrow.Width = 20
|
||||
Pen.Color = clBlue
|
||||
end
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 34
|
||||
Top = 397
|
||||
Width = 521
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 34
|
||||
ClientWidth = 521
|
||||
TabOrder = 1
|
||||
object rbRadial: TRadioButton
|
||||
Left = 8
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 49
|
||||
Caption = 'radial'
|
||||
Checked = True
|
||||
OnChange = FieldTypeChange
|
||||
TabOrder = 1
|
||||
TabStop = True
|
||||
end
|
||||
object rbTangential: TRadioButton
|
||||
Left = 77
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 73
|
||||
Caption = 'tangential'
|
||||
OnChange = FieldTypeChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 208
|
||||
Height = 15
|
||||
Top = 10
|
||||
Width = 95
|
||||
Caption = 'Max vector length'
|
||||
ParentColor = False
|
||||
end
|
||||
object edMaxVectorLength: TFloatSpinEdit
|
||||
Left = 320
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 74
|
||||
Alignment = taRightJustify
|
||||
Increment = 0.1
|
||||
MaxValue = 10
|
||||
MinValue = 0.1
|
||||
OnChange = edMaxVectorLengthChange
|
||||
TabOrder = 2
|
||||
Value = 0.5
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object lcsBubble: TListChartSource
|
||||
DataPoints.Strings = (
|
||||
|
||||
@ -6,7 +6,8 @@ interface
|
||||
|
||||
uses
|
||||
Classes, ComCtrls, ExtCtrls, StdCtrls, SysUtils, FileUtil, Forms, Controls,
|
||||
Graphics, Dialogs, TAGraph, TAMultiSeries, TASeries, TASources, TAStyles;
|
||||
Graphics, Dialogs, Spin, TAGraph, TAMultiSeries, TASeries, TASources,
|
||||
TAStyles;
|
||||
|
||||
type
|
||||
|
||||
@ -16,6 +17,8 @@ type
|
||||
ccsStacked: TCalculatedChartSource;
|
||||
cbPercentage: TCheckBox;
|
||||
cgShowStackLevels: TCheckGroup;
|
||||
chField: TChart;
|
||||
chFieldFieldSeries1: TFieldSeries;
|
||||
chOHLC: TChart;
|
||||
ChartStyles1: TChartStyles;
|
||||
chOHLCOpenHighLowCloseSeries1: TOpenHighLowCloseSeries;
|
||||
@ -27,19 +30,29 @@ type
|
||||
Chart1BubbleSeries1: TBubbleSeries;
|
||||
chStackedBarSeries1: TBarSeries;
|
||||
chWhiskersBoxAndWhiskerSeries1: TBoxAndWhiskerSeries;
|
||||
edMaxVectorLength: TFloatSpinEdit;
|
||||
Label1: TLabel;
|
||||
lcsBubble: TListChartSource;
|
||||
PageControl1: TPageControl;
|
||||
Panel1: TPanel;
|
||||
pnStackedControls: TPanel;
|
||||
rbRadial: TRadioButton;
|
||||
rbTangential: TRadioButton;
|
||||
rgStackedSeries: TRadioGroup;
|
||||
rcsStacked: TRandomChartSource;
|
||||
tsField: TTabSheet;
|
||||
tsOHLC: TTabSheet;
|
||||
tsWhiskers: TTabSheet;
|
||||
tsStacked: TTabSheet;
|
||||
tsBubble: TTabSheet;
|
||||
procedure cbPercentageChange(Sender: TObject);
|
||||
procedure cgShowStackLevelsItemClick(Sender: TObject; Index: integer);
|
||||
procedure edMaxVectorLengthChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FieldTypeChange(Sender: TObject);
|
||||
procedure rgStackedSeriesClick(Sender: TObject);
|
||||
private
|
||||
procedure CreateFieldSeriesData;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -50,7 +63,7 @@ implementation
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
TAChartUtils;
|
||||
TAChartUtils, TAGeometry;
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
@ -74,6 +87,47 @@ begin
|
||||
ccsStacked.ReorderYList := s[1..Length(s) - 1];
|
||||
end;
|
||||
|
||||
procedure TForm1.CreateFieldSeriesData;
|
||||
const
|
||||
NX = 21;
|
||||
NY = 21;
|
||||
MIN = -5.0;
|
||||
MAX = +5.0;
|
||||
var
|
||||
i, j: Integer;
|
||||
x, y, r: Double;
|
||||
v: TDoublePoint;
|
||||
begin
|
||||
v := DoublePoint(2.0, 2.0);
|
||||
r := sqrt(sqr(v.x) + sqr(v.y));
|
||||
chFieldFieldSeries1.Clear;
|
||||
for j := 0 to NY - 1 do begin
|
||||
y := MIN + (MAX - MIN) / (NY - 1) * j;
|
||||
for i := 0 to NX - 1 do begin
|
||||
x := MIN + (MAX - MIN) / (NX - 1) * i;
|
||||
r := sqr(x) + sqr(y);
|
||||
if r > 0.1 then begin
|
||||
if rbRadial.Checked then
|
||||
v := DoublePoint(x/r, y/r) // radial vector
|
||||
else
|
||||
if rbTangential.Checked then
|
||||
v := DoublePoint(y/r, -x/r); // tangential vector
|
||||
chFieldFieldSeries1.AddVector(x, y, v.x, v.y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// Since the data points, in this example, have a distance of 0.5 units we
|
||||
// can avoid overlapping of vectors if they are scaled to a length of 0.5
|
||||
// units as well.
|
||||
chFieldFieldSeries1.NormalizeVectors(0.5);
|
||||
end;
|
||||
|
||||
procedure TForm1.edMaxVectorLengthChange(Sender: TObject);
|
||||
begin
|
||||
chFieldFieldSeries1.NormalizeVectors(EdMaxVectorLength.Value);
|
||||
chField.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
var
|
||||
ylist: array [1..4] of Double;
|
||||
@ -104,6 +158,13 @@ begin
|
||||
Exchange(ylist[1], ylist[2]);
|
||||
chOHLCOpenHighLowCloseSeries1.AddXY(i, y, ylist);
|
||||
end;
|
||||
|
||||
CreateFieldSeriesData;
|
||||
end;
|
||||
|
||||
procedure TForm1.FieldTypeChange(Sender: TObject);
|
||||
begin
|
||||
CreateFieldSeriesData;
|
||||
end;
|
||||
|
||||
procedure TForm1.rgStackedSeriesClick(Sender: TObject);
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
<?xml version="1.0"?>
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
@ -46,7 +46,6 @@
|
||||
<Unit0>
|
||||
<Filename Value="multidemo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="multidemo"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="Main.pas"/>
|
||||
@ -54,7 +53,6 @@
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Main"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
@ -78,12 +76,6 @@
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
|
||||
@ -101,6 +101,10 @@ msgstr "Entf."
|
||||
msgid "Distance measurement"
|
||||
msgstr "Distanzmessung"
|
||||
|
||||
#: tachartstrconsts.rsfieldseries
|
||||
msgid "Vector field series"
|
||||
msgstr "Vektorfeld-Diagramm"
|
||||
|
||||
#: tachartstrconsts.rsfunctionseries
|
||||
msgid "Function series"
|
||||
msgstr "Funktions-Diagramm"
|
||||
|
||||
@ -89,6 +89,10 @@ msgstr "Poista"
|
||||
msgid "Distance measurement"
|
||||
msgstr "Etäisyysmittaus"
|
||||
|
||||
#: tachartstrconsts.rsfieldseries
|
||||
msgid "Vector field series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsfunctionseries
|
||||
msgid "Function series"
|
||||
msgstr "Funktiokuvaaja"
|
||||
|
||||
@ -99,6 +99,10 @@ msgstr "Supprimer"
|
||||
msgid "Distance measurement"
|
||||
msgstr "Mesure des distances"
|
||||
|
||||
#: tachartstrconsts.rsfieldseries
|
||||
msgid "Vector field series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsfunctionseries
|
||||
msgid "Function series"
|
||||
msgstr "Séries de fonctions"
|
||||
|
||||
@ -99,6 +99,10 @@ msgstr "Törlés"
|
||||
msgid "Distance measurement"
|
||||
msgstr "Távolságmérés"
|
||||
|
||||
#: tachartstrconsts.rsfieldseries
|
||||
msgid "Vector field series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsfunctionseries
|
||||
msgid "Function series"
|
||||
msgstr "Függvény"
|
||||
@ -204,3 +208,4 @@ msgstr "Nem sikerült átnevezni a komponenseket: %s"
|
||||
#: tachartstrconsts.tastoolseditortitle
|
||||
msgid "Edit tools"
|
||||
msgstr "Eszközök szerkesztése"
|
||||
|
||||
|
||||
@ -89,6 +89,10 @@ msgstr ""
|
||||
msgid "Distance measurement"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsfieldseries
|
||||
msgid "Vector field series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsfunctionseries
|
||||
msgid "Function series"
|
||||
msgstr ""
|
||||
|
||||
@ -99,6 +99,10 @@ msgstr "Удалить"
|
||||
msgid "Distance measurement"
|
||||
msgstr "Измерение расстояния"
|
||||
|
||||
#: tachartstrconsts.rsfieldseries
|
||||
msgid "Vector field series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsfunctionseries
|
||||
msgid "Function series"
|
||||
msgstr "Диаграмма по функции"
|
||||
@ -204,3 +208,4 @@ msgstr "Невозможно переименовать компоненты: %s
|
||||
#: tachartstrconsts.tastoolseditortitle
|
||||
msgid "Edit tools"
|
||||
msgstr "Редактор средств диаграмм"
|
||||
|
||||
|
||||
@ -102,6 +102,10 @@ msgstr "Radera"
|
||||
msgid "Distance measurement"
|
||||
msgstr "Avståndsmätning"
|
||||
|
||||
#: tachartstrconsts.rsfieldseries
|
||||
msgid "Vector field series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsfunctionseries
|
||||
msgid "Function series"
|
||||
msgstr "Funktionskurva"
|
||||
|
||||
@ -14,6 +14,7 @@ resourcestring
|
||||
rsColorMapSeries = 'Color map series';
|
||||
rsConstantLine = 'Constant line';
|
||||
rsCubicSplineSeries = 'Cubic spline series';
|
||||
rsFieldSeries = 'Vector field series';
|
||||
rsFunctionSeries = 'Function series';
|
||||
rsLeastSquaresFitSeries = 'Least-squares fit series';
|
||||
rsLineSeries = 'Line series';
|
||||
|
||||
@ -75,6 +75,7 @@ function NextNumberSeq(
|
||||
function PointDist(const A, B: TPoint): Integer; inline;
|
||||
function PointDistX(const A, B: TPoint): Integer; inline;
|
||||
function PointDistY(const A, B: TPoint): Integer; inline;
|
||||
function PointLineDist(const P, A, B: TPoint): Integer;
|
||||
function ProjToRect(
|
||||
const APt: TDoublePoint; const ARect: TDoubleRect): TDoublePoint;
|
||||
function RectIntersectsRect(
|
||||
@ -542,6 +543,24 @@ begin
|
||||
Result := Min(Abs(Int64(A.Y) - B.Y), MaxInt);
|
||||
end;
|
||||
|
||||
function PointLineDist(const P, A,B: TPoint): Integer;
|
||||
var
|
||||
v, w, Q: TPoint;
|
||||
dot: Int64;
|
||||
lv: Integer;
|
||||
begin
|
||||
if A = B then
|
||||
Result := PointDist(A, P)
|
||||
else begin
|
||||
v := B - A; // Vector pointing along line from A to B
|
||||
w := P - A; // Vector pointing from A to P
|
||||
dot := Int64(v.x) * w.x + Int64(v.y) * w.y; // dot product v . w
|
||||
lv := PointDist(A, B); // Length of vector AB
|
||||
Q := (v * dot) div lv; // Projection of P onto line A-B, seen from A
|
||||
Result := PointDist(Q, w); // Length from A to Q
|
||||
end;
|
||||
end;
|
||||
|
||||
function ProjToRect(
|
||||
const APt: TDoublePoint; const ARect: TDoubleRect): TDoublePoint;
|
||||
begin
|
||||
|
||||
@ -16,7 +16,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, Graphics,
|
||||
TAChartUtils, TACustomSeries, TADrawUtils, TALegend;
|
||||
TAChartUtils, TATypes, TACustomSeries, TADrawUtils, TALegend;
|
||||
|
||||
const
|
||||
DEF_BOX_WIDTH = 50;
|
||||
@ -185,6 +185,43 @@ type
|
||||
property Source;
|
||||
end;
|
||||
|
||||
TFieldSeries = class(TBasicPointSeries)
|
||||
private
|
||||
FArrow: TChartArrow;
|
||||
FPen: TPen;
|
||||
procedure SetArrow(AValue: TChartArrow);
|
||||
procedure SetPen(AValue: TPen);
|
||||
protected
|
||||
procedure AfterAdd; override;
|
||||
procedure DrawVector(ADrawer: IChartDrawer; AStartPt, AEndPt: TDoublePoint;
|
||||
APen: TPen);
|
||||
function GetColor(AIndex: Integer): TColor; inline;
|
||||
function GetVectorPoints(AIndex: Integer;
|
||||
out AStartPt, AEndPt: TDoublePoint): Boolean; inline;
|
||||
public
|
||||
procedure Assign(ASource: TPersistent); override;
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
function AddVector(AX, AY, AVectorX, AVectorY: Double; AXLabel: String = '';
|
||||
AColor: TColor = clTAColor): Integer; //inline;
|
||||
function GetVector(AIndex: Integer): TDoublePoint; inline;
|
||||
procedure SetVector(AIndex: Integer; const AValue: TDoublePoint); inline;
|
||||
|
||||
procedure Draw(ADrawer: IChartDrawer); override;
|
||||
function Extent: TDoubleRect; override;
|
||||
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
||||
function GetNearestPoint(const AParams: TNearestPointParams;
|
||||
out AResults: TNearestPointResults): Boolean; override;
|
||||
procedure NormalizeVectors(ALength: Double);
|
||||
|
||||
published
|
||||
property Arrow: TChartArrow read FArrow write SetArrow;
|
||||
property AxisIndexX;
|
||||
property AxisIndexY;
|
||||
property Pen: TPen read FPen write SetPen;
|
||||
property Source;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
@ -218,6 +255,14 @@ type
|
||||
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
|
||||
end;
|
||||
|
||||
TLegendItemField = class(TLegendItemLine)
|
||||
strict private
|
||||
FArrow: TChartArrow;
|
||||
public
|
||||
constructor Create(APen: TPen; AArrow: TChartArrow; const AText: String);
|
||||
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
|
||||
end;
|
||||
|
||||
{ TLegendItemOHLCLine }
|
||||
|
||||
constructor TLegendItemOHLCLine.Create(ASeries: TOpenHighLowCloseSeries; const AText: String);
|
||||
@ -340,6 +385,39 @@ begin
|
||||
ADrawer.Line(symbol[5].TopLeft, symbol[5].BottomRight);
|
||||
end;
|
||||
|
||||
{ TLegendItemField }
|
||||
|
||||
constructor TLegendItemField.Create(APen: TPen; AArrow: TChartArrow;
|
||||
const AText: String);
|
||||
begin
|
||||
inherited Create(APen, AText);
|
||||
FArrow := AArrow;
|
||||
end;
|
||||
|
||||
procedure TLegendItemField.Draw(ADrawer: IChartDrawer; const ARect: TRect);
|
||||
var
|
||||
y: Integer;
|
||||
len: Double;
|
||||
arr: TChartArrow;
|
||||
begin
|
||||
inherited Draw(ADrawer, ARect);
|
||||
if (FPen = nil) or (FArrow = nil) or not FArrow.Visible then
|
||||
exit;
|
||||
len := (ARect.Right - ARect.Left) * 0.01;
|
||||
arr := TChartArrow.Create(nil);
|
||||
try
|
||||
arr.Assign(FArrow);
|
||||
arr.SetOwner(nil);
|
||||
arr.BaseLength := round(FArrow.BaseLength * len);
|
||||
arr.Length := round(FArrow.Length * len);
|
||||
arr.Width := round(FArrow.Width * len);
|
||||
y := (ARect.Top + ARect.Bottom) div 2;
|
||||
arr.Draw(ADrawer, Point(ARect.Right, y), 0, FPen);
|
||||
finally
|
||||
arr.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TBubbleSeries }
|
||||
|
||||
@ -939,9 +1017,244 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TFieldSeries }
|
||||
|
||||
constructor TFieldSeries.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ListSource.XCount := 2;
|
||||
ListSource.YCount := 2;
|
||||
FArrow := TChartArrow.Create(ParentChart);
|
||||
FArrow.Length := 20;
|
||||
FArrow.Width := 10;
|
||||
FArrow.Visible := true;
|
||||
FPen := TPen.Create;
|
||||
FPen.OnChange := @StyleChanged;
|
||||
end;
|
||||
|
||||
destructor TFieldSeries.Destroy;
|
||||
begin
|
||||
FreeAndNil(FArrow);
|
||||
FreeAndNil(FPen);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TFieldSeries.AddVector(AX, AY, AVectorX, AVectorY: Double;
|
||||
AXLabel: String = ''; AColor: TColor = clTAColor): Integer;
|
||||
begin
|
||||
Result := AddXY(AX, AY, AXLabel, AColor);
|
||||
SetVector(Result, DoublePoint(AVectorX, AVectorY));
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.AfterAdd;
|
||||
begin
|
||||
inherited;
|
||||
FArrow.SetOwner(ParentChart);
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.Assign(ASource: TPersistent);
|
||||
begin
|
||||
if ASource is TFieldSeries then
|
||||
with TFieldSeries(ASource) do begin
|
||||
Self.FArrow.Assign(FArrow);
|
||||
Self.FPen := FPen;
|
||||
end;
|
||||
inherited Assign(ASource);
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.Draw(ADrawer: IChartDrawer);
|
||||
var
|
||||
ext: TDoubleRect;
|
||||
i: Integer;
|
||||
p1, p2: TDoublePoint;
|
||||
lPen: TPen;
|
||||
begin
|
||||
with Extent do begin
|
||||
ext.a := AxisToGraph(a);
|
||||
ext.b := AxisToGraph(b);
|
||||
end;
|
||||
NormalizeRect(ext);
|
||||
// Do not draw anything if the series extent does not intersect CurrentExtent.
|
||||
if not RectIntersectsRect(ext, ParentChart.CurrentExtent) then exit;
|
||||
|
||||
lPen := TPen.Create;
|
||||
lPen.Assign(FPen);
|
||||
|
||||
if (AxisIndexX < 0) and (AxisIndexY < 0) then begin
|
||||
// Optimization: bypass transformations in the default case
|
||||
for i := 0 to Count - 1 do
|
||||
if GetVectorPoints(i, p1, p2) then begin
|
||||
lPen.Color := GetColor(i);
|
||||
DrawVector(ADrawer, p1, p2, lPen);
|
||||
end;
|
||||
end else begin
|
||||
for i := 0 to Count - 1 do
|
||||
if GetVectorPoints(i, p1, p2) then begin
|
||||
p1 := DoublePoint(AxisToGraphX(p1.X), AxisToGraphY(p1.Y));
|
||||
p2 := DoublePoint(AxisToGraphX(p2.X), AxisToGraphY(p2.Y));
|
||||
lPen.Color := GetColor(i);
|
||||
DrawVector(ADrawer, p1, p2, lPen);
|
||||
end;
|
||||
end;
|
||||
|
||||
lPen.Free;
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.DrawVector(ADrawer: IChartDrawer;
|
||||
AStartPt, AEndPt: TDoublePoint; APen: TPen);
|
||||
var
|
||||
p1, p2: TPoint;
|
||||
arr: TChartArrow;
|
||||
len: Double;
|
||||
begin
|
||||
p1 := ParentChart.GraphToImage(AStartPt);
|
||||
p2 := ParentChart.GraphToImage(AEndPt);
|
||||
ADrawer.Pen := APen;
|
||||
ADrawer.Line(p1.x, p1.y, p2.x, p2.y);
|
||||
if FArrow.Visible then begin
|
||||
len := sqrt(sqr(p2.x - p1.x) + sqr(p2.y - p1.y)) * 0.01;
|
||||
arr := TChartArrow.Create(nil);
|
||||
arr.Assign(FArrow);
|
||||
arr.SetOwner(nil); // avoid repainting due to next commands
|
||||
arr.BaseLength := round(FArrow.BaseLength * len);
|
||||
arr.Length := round(FArrow.Length * len);
|
||||
arr.Width := round(FArrow.Width * len);
|
||||
arr.Draw(ADrawer, p2, arctan2(p2.y-p1.y, p2.x-p1.x), APen);
|
||||
arr.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFieldSeries.Extent: TDoubleRect;
|
||||
var
|
||||
p1, p2: TDoublePoint;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := Source.Extent;
|
||||
for i := 0 to Source.Count - 1 do
|
||||
if GetVectorPoints(i, p1, p2) then begin
|
||||
UpdateMinMax(p1.X, Result.a.X, Result.b.X);
|
||||
UpdateMinMax(p2.X, Result.a.X, Result.b.X);
|
||||
UpdateMinMax(p1.Y, Result.a.Y, Result.b.Y);
|
||||
UpdateMinMax(p2.Y, Result.a.Y, Result.b.Y);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFieldSeries.GetColor(AIndex: Integer): TColor;
|
||||
begin
|
||||
with Source.Item[AIndex]^ do
|
||||
Result := TColor(IfThen(Color = clTAColor, FPen.Color, Color));
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.GetLegendItems(AItems: TChartLegendItems);
|
||||
begin
|
||||
AItems.Add(TLegendItemField.Create(FPen, FArrow, LegendTextSingle));
|
||||
end;
|
||||
|
||||
function TFieldSeries.GetNearestPoint(const AParams: TNearestPointParams;
|
||||
out AResults: TNearestPointResults): Boolean;
|
||||
var
|
||||
dist, i: Integer;
|
||||
pt1, pt2: TPoint;
|
||||
sp1, sp2: TDoublePoint;
|
||||
R: TRect;
|
||||
begin
|
||||
AResults.FDist := Sqr(AParams.FRadius) + 1;
|
||||
AResults.FIndex := -1;
|
||||
for i := 0 to Count - 1 do begin
|
||||
if not GetVectorPoints(i, sp1, sp2) then
|
||||
Continue;
|
||||
// End points of the vector arrow
|
||||
pt1 := ParentChart.GraphToImage(AxisToGraph(sp1));
|
||||
pt2 := ParentChart.GraphToImage(AxisToGraph(sp2));
|
||||
// At first we check if the point is in the rect spanned by the vector.
|
||||
R := Rect(pt1.x, pt1.y, pt2.x, pt2.y);
|
||||
NormalizeRect(R);
|
||||
R.TopLeft := R.TopLeft - Point(AParams.FRadius, AParams.FRadius);
|
||||
R.BottomRight := R.BottomRight + Point(AParams.FRadius, AParams.FRadius);
|
||||
if not IsPointInRect(AParams.FPoint, R) then continue;
|
||||
// Calculate distance of point from line
|
||||
dist := PointLineDist(AParams.FPoint, pt1, pt2);
|
||||
if dist >= AParams.FRadius then continue;
|
||||
AResults.FDist := dist;
|
||||
AResults.FIndex := i;
|
||||
AResults.FImg := (pt1 + pt2) div 2;
|
||||
AResults.FValue := Source.Item[i]^.Point;
|
||||
break;
|
||||
end;
|
||||
Result := AResults.FIndex >= 0;
|
||||
end;
|
||||
|
||||
function TFieldSeries.GetVector(AIndex: Integer): TDoublePoint;
|
||||
begin
|
||||
with Source.Item[AIndex]^ do
|
||||
Result := DoublePoint(XList[0], YList[0]);
|
||||
end;
|
||||
|
||||
function TFieldSeries.GetVectorPoints(AIndex: Integer;
|
||||
out AStartPt, AEndPt: TDoublePoint): Boolean;
|
||||
var
|
||||
dx, dy: Double;
|
||||
begin
|
||||
with Source.Item[AIndex]^ do begin
|
||||
if isNaN(X) or IsNaN(Y) or IsNaN(XList[0]) or IsNaN(YList[0]) then
|
||||
exit(false)
|
||||
else begin
|
||||
dx := XList[0] * 0.5;
|
||||
dy := YList[0] * 0.5;
|
||||
AStartPt := DoublePoint(X - dx, Y - dy);
|
||||
AEndPt := DoublePoint(X + dx, Y + dy);
|
||||
Result := true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.NormalizeVectors(ALength: Double);
|
||||
var
|
||||
factor, maxlen, len: Double;
|
||||
i: Integer;
|
||||
v: TDoublePoint;
|
||||
begin
|
||||
maxLen := 0;
|
||||
for i := 0 to Count - 1 do begin
|
||||
v := GetVector(i);
|
||||
len := v.x * v.x + v.y * v.y;
|
||||
len := sqrt(v.x*v.x + v.y*v.y);
|
||||
// len := sqrt(sqr(v.x) + sqr(v.y));
|
||||
maxLen := Max(len, maxlen);
|
||||
end;
|
||||
if maxLen = 0 then
|
||||
exit;
|
||||
factor := ALength / maxLen;
|
||||
for i := 0 to Count - 1 do begin
|
||||
v := GetVector(i);
|
||||
SetVector(i, v*factor);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.SetArrow(AValue: TChartArrow);
|
||||
begin
|
||||
FArrow.Assign(AValue);
|
||||
UpdateParentChart;
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.SetPen(AValue: TPen);
|
||||
begin
|
||||
FPen.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TFieldSeries.SetVector(AIndex: Integer; const AValue: TDoublePoint);
|
||||
begin
|
||||
with ListSource.Item[AIndex]^ do begin
|
||||
XList[0] := AValue.X;
|
||||
YList[0] := AValue.Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterSeriesClass(TBubbleSeries, @rsBubbleSeries);
|
||||
RegisterSeriesClass(TBoxAndWhiskerSeries, @rsBoxAndWhiskerSeries);
|
||||
RegisterSeriesClass(TOpenHighLowCloseSeries, @rsOpenHighLowCloseSeries);
|
||||
RegisterSeriesClass(TFieldSeries, @rsFieldSeries);
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user