Chart Control V1
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,698 @@
|
||||
unit TestChartControl;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Types,
|
||||
System.UITypes,
|
||||
System.Classes,
|
||||
System.Variants,
|
||||
System.Generics.Collections,
|
||||
System.Math,
|
||||
System.UIConsts, // For AlphaColors
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
FMX.Forms,
|
||||
FMX.Graphics,
|
||||
FMX.Dialogs,
|
||||
FMX.Objects,
|
||||
Myc.Trade.DataPoint;
|
||||
|
||||
type
|
||||
// Declared for testing, will be moved to external unit
|
||||
TOhlcItem = record
|
||||
Open, High, Low, Close: Double;
|
||||
end;
|
||||
|
||||
// Custom high-precision point type using Double.
|
||||
TPointD = record
|
||||
public
|
||||
X: Double;
|
||||
Y: Double;
|
||||
constructor Create(AX, AY: Double);
|
||||
end;
|
||||
|
||||
// Custom high-precision rectangle type using Double.
|
||||
TRectD = record
|
||||
private
|
||||
function GetHeight: Double;
|
||||
function GetWidth: Double;
|
||||
public
|
||||
Left, Top, Right, Bottom: Double;
|
||||
constructor Create(const ALeft, ATop, ARight, ABottom: Double); overload;
|
||||
constructor Create(const ATopLeft, ABottomRight: TPointD); overload;
|
||||
property Width: Double read GetWidth;
|
||||
property Height: Double read GetHeight;
|
||||
end;
|
||||
|
||||
TChart = class; // Forward declaration
|
||||
|
||||
// Abstract base class for a single series in a chart.
|
||||
TChartSeries = class abstract(TCollectionItem)
|
||||
private
|
||||
FColor: TAlphaColor;
|
||||
FThickness: Single;
|
||||
procedure SetColor(const Value: TAlphaColor);
|
||||
procedure SetThickness(const Value: Single);
|
||||
protected
|
||||
function GetChart: TChart;
|
||||
public
|
||||
constructor Create(Collection: TCollection); override;
|
||||
// Calculates the bounding box for this series.
|
||||
procedure GetBounds(var MinPoint, MaxPoint: TPointD); virtual; abstract;
|
||||
// Draws the series on the canvas.
|
||||
procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); virtual; abstract;
|
||||
published
|
||||
property Color: TAlphaColor read FColor write SetColor;
|
||||
property Thickness: Single read FThickness write SetThickness;
|
||||
end;
|
||||
|
||||
// Generic, abstract adapter to connect a TDataSeries<T> to a TChart.
|
||||
TChartSeriesAdapter<T> = class abstract(TChartSeries)
|
||||
private
|
||||
FDataSeries: TDataSeries<T>;
|
||||
protected
|
||||
procedure SetDataSeries(const Value: TDataSeries<T>); virtual;
|
||||
// Converts a data point from the source series to a high-precision visual point for the chart.
|
||||
// May not be applicable for all series types (e.g., OHLC).
|
||||
function DataToPoint(const DataPoint: TDataPoint<T>): TPointD; virtual; abstract;
|
||||
public
|
||||
constructor Create(Collection: TCollection); override;
|
||||
property DataSeries: TDataSeries<T> read FDataSeries write SetDataSeries;
|
||||
end;
|
||||
|
||||
TDataSourceField = (dsfAsk, dsfBid);
|
||||
|
||||
// Concrete series implementation for displaying TDataSeries<TAskBidItem>.
|
||||
TChartAskBidSeries = class(TChartSeriesAdapter<TAskBidItem>)
|
||||
private
|
||||
FDataSourceField: TDataSourceField;
|
||||
FCachedPoints: TArray<TPointD>;
|
||||
FCacheValid: Boolean;
|
||||
procedure SetDataSourceField(const Value: TDataSourceField);
|
||||
procedure EnsureCacheIsValid;
|
||||
protected
|
||||
procedure SetDataSeries(const Value: TDataSeries<TAskBidItem>); override;
|
||||
function DataToPoint(const DataPoint: TDataPoint<TAskBidItem>): TPointD; override;
|
||||
public
|
||||
constructor Create(Collection: TCollection); override;
|
||||
procedure GetBounds(var MinPoint, MaxPoint: TPointD); override;
|
||||
procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override;
|
||||
published
|
||||
property DataSourceField: TDataSourceField read FDataSourceField write SetDataSourceField;
|
||||
end;
|
||||
|
||||
// Concrete series implementation for displaying TDataSeries<TOhlcItem> as candlesticks.
|
||||
TChartOhlcSeries = class(TChartSeriesAdapter<TOhlcItem>)
|
||||
private
|
||||
FUpColor: TAlphaColor;
|
||||
FDownColor: TAlphaColor;
|
||||
protected
|
||||
// This function is not used for OHLC drawing but must be implemented.
|
||||
function DataToPoint(const DataPoint: TDataPoint<TOhlcItem>): TPointD; override;
|
||||
public
|
||||
constructor Create(Collection: TCollection); override;
|
||||
procedure GetBounds(var MinPoint, MaxPoint: TPointD); override;
|
||||
procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override;
|
||||
published
|
||||
property UpColor: TAlphaColor read FUpColor write FUpColor;
|
||||
property DownColor: TAlphaColor read FDownColor write FDownColor;
|
||||
end;
|
||||
|
||||
TChartSeriesCollection = class(TCollection)
|
||||
private
|
||||
[weak]
|
||||
FOwner: TChart;
|
||||
function GetItem(Index: Integer): TChartSeries;
|
||||
procedure SetItem(Index: Integer; const Value: TChartSeries);
|
||||
protected
|
||||
function GetOwner: TPersistent; override;
|
||||
procedure Update(Item: TCollectionItem); override;
|
||||
public
|
||||
constructor Create(AOwner: TChart);
|
||||
property Items[Index: Integer]: TChartSeries read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
// A control for displaying charts.
|
||||
TChart = class(TControl)
|
||||
private
|
||||
FSeries: TChartSeriesCollection;
|
||||
FAxisColor: TAlphaColor;
|
||||
FGridColor: TAlphaColor;
|
||||
FPadding: Single;
|
||||
procedure SetSeries(const Value: TChartSeriesCollection);
|
||||
procedure SetAxisColor(const Value: TAlphaColor);
|
||||
procedure SetGridColor(const Value: TAlphaColor);
|
||||
procedure SetPadding(const Value: Single);
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure RecalcDataBounds(out MinPoint, MaxPoint: TPointD);
|
||||
procedure DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
|
||||
procedure DrawGrid(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure Repaint;
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property Series: TChartSeriesCollection read FSeries write SetSeries;
|
||||
property AxisColor: TAlphaColor read FAxisColor write SetAxisColor;
|
||||
property GridColor: TAlphaColor read FGridColor write SetGridColor;
|
||||
property Padding: Single read FPadding write SetPadding;
|
||||
end;
|
||||
|
||||
TTestChartForm = class(TForm)
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
FChart: TChart;
|
||||
public
|
||||
end;
|
||||
|
||||
var
|
||||
TestChartForm: TTestChartForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
{ TPointD }
|
||||
|
||||
constructor TPointD.Create(AX, AY: Double);
|
||||
begin
|
||||
X := AX;
|
||||
Y := AY;
|
||||
end;
|
||||
|
||||
{ TRectD }
|
||||
|
||||
constructor TRectD.Create(const ALeft, ATop, ARight, ABottom: Double);
|
||||
begin
|
||||
Left := ALeft;
|
||||
Top := ATop;
|
||||
Right := ARight;
|
||||
Bottom := ABottom;
|
||||
end;
|
||||
|
||||
constructor TRectD.Create(const ATopLeft, ABottomRight: TPointD);
|
||||
begin
|
||||
Left := ATopLeft.X;
|
||||
Top := ATopLeft.Y;
|
||||
Right := ABottomRight.X;
|
||||
Bottom := ABottomRight.Y;
|
||||
end;
|
||||
|
||||
function TRectD.GetHeight: Double;
|
||||
begin
|
||||
Result := Bottom - Top;
|
||||
end;
|
||||
|
||||
function TRectD.GetWidth: Double;
|
||||
begin
|
||||
Result := Right - Left;
|
||||
end;
|
||||
|
||||
{ TChartSeries }
|
||||
|
||||
constructor TChartSeries.Create(Collection: TCollection);
|
||||
begin
|
||||
inherited Create(Collection);
|
||||
FColor := TAlphaColors.Black; // Default color for wicks in OHLC
|
||||
FThickness := 1;
|
||||
end;
|
||||
|
||||
function TChartSeries.GetChart: TChart;
|
||||
begin
|
||||
Result := (Collection as TChartSeriesCollection).GetOwner as TChart;
|
||||
end;
|
||||
|
||||
procedure TChartSeries.SetColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if (FColor <> Value) then
|
||||
begin
|
||||
FColor := Value;
|
||||
if Assigned(Collection) then
|
||||
Changed(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChartSeries.SetThickness(const Value: Single);
|
||||
begin
|
||||
if (FThickness <> Value) then
|
||||
begin
|
||||
FThickness := Value;
|
||||
if Assigned(Collection) then
|
||||
Changed(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TChartSeriesAdapter<T> }
|
||||
|
||||
constructor TChartSeriesAdapter<T>.Create(Collection: TCollection);
|
||||
begin
|
||||
inherited Create(Collection);
|
||||
FDataSeries := TDataSeries<T>.Null;
|
||||
end;
|
||||
|
||||
procedure TChartSeriesAdapter<T>.SetDataSeries(const Value: TDataSeries<T>);
|
||||
begin
|
||||
FDataSeries := Value;
|
||||
if Assigned(Collection) then
|
||||
Changed(False);
|
||||
end;
|
||||
|
||||
{ TChartAskBidSeries }
|
||||
|
||||
constructor TChartAskBidSeries.Create(Collection: TCollection);
|
||||
begin
|
||||
inherited Create(Collection);
|
||||
Self.Color := TAlphaColors.Blue; // Override default for line charts
|
||||
Self.Thickness := 2;
|
||||
FDataSourceField := dsfAsk;
|
||||
FCacheValid := False;
|
||||
end;
|
||||
|
||||
procedure TChartAskBidSeries.EnsureCacheIsValid;
|
||||
var
|
||||
i: Int64;
|
||||
pointCount: Int64;
|
||||
begin
|
||||
if FCacheValid then
|
||||
Exit;
|
||||
pointCount := DataSeries.Count;
|
||||
SetLength(FCachedPoints, pointCount);
|
||||
if (pointCount > 0) then
|
||||
begin
|
||||
for i := 0 to pointCount - 1 do
|
||||
begin
|
||||
FCachedPoints[i] := DataToPoint(DataSeries[pointCount - 1 - i]);
|
||||
end;
|
||||
end;
|
||||
FCacheValid := True;
|
||||
end;
|
||||
|
||||
procedure TChartAskBidSeries.GetBounds(var MinPoint, MaxPoint: TPointD);
|
||||
var
|
||||
pt: TPointD;
|
||||
isFirst: Boolean;
|
||||
begin
|
||||
EnsureCacheIsValid;
|
||||
if (Length(FCachedPoints) = 0) then
|
||||
Exit;
|
||||
isFirst := (MinPoint.X = MaxPoint.X) and (MinPoint.Y = MaxPoint.Y);
|
||||
if isFirst then
|
||||
begin
|
||||
MinPoint := FCachedPoints[0];
|
||||
MaxPoint := FCachedPoints[0];
|
||||
end;
|
||||
for pt in FCachedPoints do
|
||||
begin
|
||||
MinPoint.X := Min(MinPoint.X, pt.X);
|
||||
MinPoint.Y := Min(MinPoint.Y, pt.Y);
|
||||
MaxPoint.X := Max(MaxPoint.X, pt.X);
|
||||
MaxPoint.Y := Max(MaxPoint.Y, pt.Y);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChartAskBidSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
|
||||
var
|
||||
scaleX, scaleY: Double;
|
||||
pt1, pt2: TPointD;
|
||||
transformedPt1, transformedPt2: TPointF;
|
||||
j: Integer;
|
||||
begin
|
||||
EnsureCacheIsValid;
|
||||
if Length(FCachedPoints) < 2 then
|
||||
Exit;
|
||||
if (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
|
||||
Exit;
|
||||
scaleX := ACanvasRect.Width / ADataRect.Width;
|
||||
scaleY := ACanvasRect.Height / ADataRect.Height;
|
||||
ACanvas.Stroke.Kind := TBrushKind.Solid;
|
||||
ACanvas.Stroke.Color := Self.Color;
|
||||
ACanvas.Stroke.Thickness := Self.Thickness;
|
||||
pt1 := FCachedPoints[0];
|
||||
for j := 1 to High(FCachedPoints) do
|
||||
begin
|
||||
pt2 := FCachedPoints[j];
|
||||
transformedPt1.X := ACanvasRect.Left + (pt1.X - ADataRect.Left) * scaleX;
|
||||
transformedPt1.Y := ACanvasRect.Bottom - (pt1.Y - ADataRect.Top) * scaleY;
|
||||
transformedPt2.X := ACanvasRect.Left + (pt2.X - ADataRect.Left) * scaleX;
|
||||
transformedPt2.Y := ACanvasRect.Bottom - (pt2.Y - ADataRect.Top) * scaleY;
|
||||
ACanvas.DrawLine(transformedPt1, transformedPt2, 1);
|
||||
pt1 := pt2;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChartAskBidSeries.SetDataSeries(const Value: TDataSeries<TAskBidItem>);
|
||||
begin
|
||||
inherited SetDataSeries(Value);
|
||||
FCacheValid := False;
|
||||
end;
|
||||
|
||||
function TChartAskBidSeries.DataToPoint(const DataPoint: TDataPoint<TAskBidItem>): TPointD;
|
||||
begin
|
||||
Result.X := DataPoint.Time;
|
||||
case FDataSourceField of
|
||||
dsfAsk: Result.Y := DataPoint.Data.Ask;
|
||||
dsfBid: Result.Y := DataPoint.Data.Bid;
|
||||
else
|
||||
Result.Y := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChartAskBidSeries.SetDataSourceField(const Value: TDataSourceField);
|
||||
begin
|
||||
if (FDataSourceField <> Value) then
|
||||
begin
|
||||
FDataSourceField := Value;
|
||||
FCacheValid := False;
|
||||
if Assigned(Collection) then
|
||||
Changed(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TChartOhlcSeries }
|
||||
|
||||
constructor TChartOhlcSeries.Create(Collection: TCollection);
|
||||
begin
|
||||
inherited Create(Collection);
|
||||
FUpColor := TAlphaColors.Green;
|
||||
FDownColor := TAlphaColors.Red;
|
||||
end;
|
||||
|
||||
function TChartOhlcSeries.DataToPoint(const DataPoint: TDataPoint<TOhlcItem>): TPointD;
|
||||
begin
|
||||
// Not used for OHLC series drawing, but must be implemented for the abstract parent.
|
||||
Result.X := DataPoint.Time;
|
||||
Result.Y := DataPoint.Data.Close;
|
||||
end;
|
||||
|
||||
procedure TChartOhlcSeries.GetBounds(var MinPoint, MaxPoint: TPointD);
|
||||
var
|
||||
isFirst: Boolean;
|
||||
i: Int64;
|
||||
dataPoint: TDataPoint<TOhlcItem>;
|
||||
begin
|
||||
if (DataSeries.Count = 0) then
|
||||
Exit;
|
||||
isFirst := (MinPoint.X > MaxPoint.X); // A more robust check for an uninitialized state
|
||||
for i := 0 to DataSeries.Count - 1 do
|
||||
begin
|
||||
dataPoint := DataSeries[i];
|
||||
if isFirst then
|
||||
begin
|
||||
MinPoint.X := dataPoint.Time;
|
||||
MaxPoint.X := dataPoint.Time;
|
||||
MinPoint.Y := dataPoint.Data.Low;
|
||||
MaxPoint.Y := dataPoint.Data.High;
|
||||
isFirst := False;
|
||||
end
|
||||
else
|
||||
begin
|
||||
MinPoint.X := Min(MinPoint.X, dataPoint.Time);
|
||||
MaxPoint.X := Max(MaxPoint.X, dataPoint.Time);
|
||||
MinPoint.Y := Min(MinPoint.Y, dataPoint.Data.Low);
|
||||
MaxPoint.Y := Max(MaxPoint.Y, dataPoint.Data.High);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChartOhlcSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
|
||||
var
|
||||
scaleX, scaleY: Double;
|
||||
i: Int64;
|
||||
dataPoint: TDataPoint<TOhlcItem>;
|
||||
x_center, candleWidth: Single;
|
||||
y_high, y_low, y_open, y_close: Single;
|
||||
body: TRectF;
|
||||
begin
|
||||
if (DataSeries.Count = 0) or (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
|
||||
Exit;
|
||||
scaleX := ACanvasRect.Width / ADataRect.Width;
|
||||
scaleY := ACanvasRect.Height / ADataRect.Height;
|
||||
candleWidth := Max(3.0, (ACanvasRect.Width / DataSeries.Count) * 0.8);
|
||||
|
||||
for i := 0 to DataSeries.Count - 1 do
|
||||
begin
|
||||
dataPoint := DataSeries[i];
|
||||
x_center := ACanvasRect.Left + (dataPoint.Time - ADataRect.Left) * scaleX;
|
||||
y_high := ACanvasRect.Bottom - (dataPoint.Data.High - ADataRect.Top) * scaleY;
|
||||
y_low := ACanvasRect.Bottom - (dataPoint.Data.Low - ADataRect.Top) * scaleY;
|
||||
y_open := ACanvasRect.Bottom - (dataPoint.Data.Open - ADataRect.Top) * scaleY;
|
||||
y_close := ACanvasRect.Bottom - (dataPoint.Data.Close - ADataRect.Top) * scaleY;
|
||||
|
||||
ACanvas.Stroke.Color := Self.Color;
|
||||
ACanvas.Stroke.Thickness := Self.Thickness;
|
||||
ACanvas.DrawLine(TPointF.Create(x_center, y_high), TPointF.Create(x_center, y_low), 1.0);
|
||||
|
||||
if (dataPoint.Data.Close >= dataPoint.Data.Open) then
|
||||
ACanvas.Fill.Color := FUpColor
|
||||
else
|
||||
ACanvas.Fill.Color := FDownColor;
|
||||
|
||||
body := TRectF.Create(x_center - candleWidth / 2, y_open, x_center + candleWidth / 2, y_close);
|
||||
NormalizeRect(body);
|
||||
ACanvas.FillRect(body, 0, 0, [], 1.0);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TChartSeriesCollection }
|
||||
|
||||
constructor TChartSeriesCollection.Create(AOwner: TChart);
|
||||
begin
|
||||
inherited Create(TChartSeries);
|
||||
FOwner := AOwner;
|
||||
end;
|
||||
|
||||
function TChartSeriesCollection.GetItem(Index: Integer): TChartSeries;
|
||||
begin
|
||||
Result := TChartSeries(inherited GetItem(Index));
|
||||
end;
|
||||
|
||||
function TChartSeriesCollection.GetOwner: TPersistent;
|
||||
begin
|
||||
Result := FOwner;
|
||||
end;
|
||||
|
||||
procedure TChartSeriesCollection.SetItem(Index: Integer; const Value: TChartSeries);
|
||||
begin
|
||||
inherited SetItem(Index, Value);
|
||||
end;
|
||||
|
||||
procedure TChartSeriesCollection.Update(Item: TCollectionItem);
|
||||
begin
|
||||
inherited;
|
||||
if Assigned(FOwner) then
|
||||
FOwner.Repaint;
|
||||
end;
|
||||
|
||||
{ TChart }
|
||||
|
||||
constructor TChart.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FSeries := TChartSeriesCollection.Create(Self);
|
||||
FAxisColor := TAlphaColors.Black;
|
||||
FGridColor := TAlphaColors.Lightgray;
|
||||
FPadding := 30;
|
||||
end;
|
||||
|
||||
destructor TChart.Destroy;
|
||||
begin
|
||||
FSeries.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TChart.Paint;
|
||||
var
|
||||
minPt, maxPt: TPointD;
|
||||
dataRect: TRectD;
|
||||
canvasRect: TRectF;
|
||||
series: TCollectionItem;
|
||||
hasData: Boolean;
|
||||
begin
|
||||
inherited;
|
||||
Canvas.Fill.Color := TAlphaColors.White;
|
||||
Canvas.FillRect(LocalRect, 1);
|
||||
if (FSeries.Count = 0) then
|
||||
Exit;
|
||||
|
||||
RecalcDataBounds(minPt, maxPt);
|
||||
hasData := (minPt.X < maxPt.X) and (minPt.Y < maxPt.Y);
|
||||
|
||||
if not hasData then
|
||||
Exit;
|
||||
|
||||
dataRect := TRectD.Create(minPt, maxPt);
|
||||
canvasRect := Self.LocalRect;
|
||||
canvasRect.Inflate(-FPadding, -FPadding);
|
||||
|
||||
if (canvasRect.Width < 1) or (canvasRect.Height < 1) then
|
||||
Exit;
|
||||
|
||||
DrawGrid(Canvas, dataRect, canvasRect);
|
||||
DrawAxes(Canvas, dataRect, canvasRect);
|
||||
|
||||
for series in FSeries do
|
||||
begin
|
||||
(series as TChartSeries).Draw(Canvas, dataRect, canvasRect);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChart.RecalcDataBounds(out MinPoint, MaxPoint: TPointD);
|
||||
var
|
||||
series: TCollectionItem;
|
||||
begin
|
||||
MinPoint := TPointD.Create(Infinity, Infinity);
|
||||
MaxPoint := TPointD.Create(NegInfinity, NegInfinity);
|
||||
|
||||
for series in FSeries do
|
||||
begin
|
||||
(series as TChartSeries).GetBounds(MinPoint, MaxPoint);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChart.DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
|
||||
begin
|
||||
ACanvas.Stroke.Kind := TBrushKind.Solid;
|
||||
ACanvas.Stroke.Color := FAxisColor;
|
||||
ACanvas.Stroke.Thickness := 1;
|
||||
ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, ACanvasRect.Bottom), TPointF.Create(ACanvasRect.Right, ACanvasRect.Bottom), 1);
|
||||
ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, ACanvasRect.Top), TPointF.Create(ACanvasRect.Left, ACanvasRect.Bottom), 1);
|
||||
end;
|
||||
|
||||
procedure TChart.DrawGrid(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
|
||||
var
|
||||
i: Integer;
|
||||
x, y: Single;
|
||||
const
|
||||
GridLines = 5;
|
||||
begin
|
||||
ACanvas.Stroke.Kind := TBrushKind.Solid;
|
||||
ACanvas.Stroke.Color := FGridColor;
|
||||
ACanvas.Stroke.Thickness := 1;
|
||||
ACanvas.Stroke.Dash := TStrokeDash.Dot;
|
||||
for i := 1 to GridLines do
|
||||
begin
|
||||
x := ACanvasRect.Left + i * ACanvasRect.Width / GridLines;
|
||||
ACanvas.DrawLine(TPointF.Create(x, ACanvasRect.Top), TPointF.Create(x, ACanvasRect.Bottom), 1);
|
||||
end;
|
||||
for i := 0 to GridLines - 1 do
|
||||
begin
|
||||
y := ACanvasRect.Bottom - i * ACanvasRect.Height / GridLines;
|
||||
ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, y), TPointF.Create(ACanvasRect.Right, y), 1);
|
||||
end;
|
||||
ACanvas.Stroke.Dash := TStrokeDash.Solid;
|
||||
end;
|
||||
|
||||
procedure TChart.SetSeries(const Value: TChartSeriesCollection);
|
||||
begin
|
||||
FSeries.Assign(Value);
|
||||
end;
|
||||
|
||||
procedure TChart.SetAxisColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if (FAxisColor <> Value) then
|
||||
begin
|
||||
FAxisColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChart.SetGridColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if (FGridColor <> Value) then
|
||||
begin
|
||||
FGridColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChart.SetPadding(const Value: Single);
|
||||
begin
|
||||
if (FPadding <> Value) then
|
||||
begin
|
||||
FPadding := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChart.Repaint;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
{ TTestChartForm }
|
||||
|
||||
procedure TTestChartForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
ohlcSeries: TChartOhlcSeries;
|
||||
askSeries, bidSeries: TChartAskBidSeries;
|
||||
i: Integer;
|
||||
ohlcData: TDataSeries<TOhlcItem>;
|
||||
askBidData: TDataSeries<TAskBidItem>;
|
||||
ohlcDataPoints: array of TDataPoint<TOhlcItem>;
|
||||
askBidDataPoints: array of TDataPoint<TAskBidItem>;
|
||||
startTime: TDateTime;
|
||||
lastClose, o, h, l, c: Double;
|
||||
ohlcItem: TOhlcItem;
|
||||
const
|
||||
NUM_POINTS = 50;
|
||||
begin
|
||||
FChart := TChart.Create(Self);
|
||||
FChart.Parent := Self;
|
||||
FChart.Align := TAlignLayout.Client;
|
||||
|
||||
// 1. Create OHLC Data
|
||||
ohlcData := TDataSeries<TOhlcItem>.CreateWriteable(NUM_POINTS);
|
||||
askBidData := TDataSeries<TAskBidItem>.CreateWriteable(NUM_POINTS);
|
||||
startTime := Now;
|
||||
SetLength(ohlcDataPoints, NUM_POINTS);
|
||||
SetLength(askBidDataPoints, NUM_POINTS);
|
||||
|
||||
lastClose := 100;
|
||||
for i := 0 to NUM_POINTS - 1 do
|
||||
begin
|
||||
o := lastClose + (Random - 0.5) * 2;
|
||||
h := o + Random * 3;
|
||||
l := o - Random * 3;
|
||||
c := l + Random * (h - l);
|
||||
lastClose := c;
|
||||
|
||||
ohlcItem.Open := o;
|
||||
ohlcItem.High := h;
|
||||
ohlcItem.Low := l;
|
||||
ohlcItem.Close := c;
|
||||
ohlcDataPoints[i] := TDataPoint<TOhlcItem>.Create(startTime + i, ohlcItem);
|
||||
|
||||
// Derive Ask/Bid data from OHLC close price
|
||||
askBidDataPoints[i] :=
|
||||
TDataPoint<TAskBidItem>.Create(
|
||||
startTime + i,
|
||||
TAskBidItem.Create(c, c * 0.995) // Ask = Close, Bid = Close - 0.5% spread
|
||||
);
|
||||
end;
|
||||
ohlcData.Add(ohlcDataPoints);
|
||||
askBidData.Add(askBidDataPoints);
|
||||
|
||||
// 2. Create and add OHLC Series
|
||||
ohlcSeries := TChartOhlcSeries.Create(FChart.Series);
|
||||
ohlcSeries.DataSeries := ohlcData;
|
||||
|
||||
// 3. Create and add Ask/Bid Line Series
|
||||
askSeries := TChartAskBidSeries.Create(FChart.Series);
|
||||
askSeries.DataSeries := askBidData;
|
||||
askSeries.DataSourceField := dsfAsk;
|
||||
askSeries.Color := TAlphaColors.Blue;
|
||||
askSeries.Thickness := 2;
|
||||
|
||||
bidSeries := TChartAskBidSeries.Create(FChart.Series);
|
||||
bidSeries.DataSeries := askBidData;
|
||||
bidSeries.DataSourceField := dsfBid;
|
||||
bidSeries.Color := TAlphaColors.Orange;
|
||||
bidSeries.Thickness := 2;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user