Michael Schimmel
420 lines
12 KiB
ObjectPascal
420 lines
12 KiB
ObjectPascal
unit Myc.Fmx.Chart;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Classes,
|
|
System.Types,
|
|
System.Generics.Collections,
|
|
System.UITypes,
|
|
System.UIConsts,
|
|
System.Messaging,
|
|
System.Math.Vectors,
|
|
FMX.Types,
|
|
FMX.Controls,
|
|
FMX.Graphics,
|
|
Myc.Trade.DataPoint,
|
|
Myc.Signals;
|
|
|
|
type
|
|
TCandleStyle = (csCandleStick, csHiLoBar);
|
|
|
|
TMycChart = class(TStyledControl)
|
|
type
|
|
TSeries = class abstract(TContainedObject)
|
|
private
|
|
function GetMainSeries: TSeries;
|
|
function GetOwner: TMycChart;
|
|
protected
|
|
function GetCount: Int64; virtual; abstract;
|
|
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract;
|
|
function Update: Boolean; virtual; abstract;
|
|
procedure Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>); virtual; abstract;
|
|
|
|
public
|
|
constructor Create(AOwner: TMycChart);
|
|
property Count: Int64 read GetCount;
|
|
property MainSeries: TSeries read GetMainSeries;
|
|
property Owner: TMycChart read GetOwner;
|
|
end;
|
|
|
|
private
|
|
FSeriesList: TList<TSeries>;
|
|
FLookback: Integer;
|
|
FIdleSubscrId: TMessageSubscriptionId;
|
|
protected
|
|
procedure Paint; override;
|
|
procedure DoIdle;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
// Creates an OHLC candlestick/bar series
|
|
function CreateOhlcListener(
|
|
const AUpColor: TAlphaColor = TAlphaColors.Green;
|
|
const ADownColor: TAlphaColor = TAlphaColors.Red;
|
|
const AStyle: TCandleStyle = csCandleStick
|
|
): IMycProcessor<TArray<TDataPoint<TOhlcItem>>>;
|
|
|
|
// Creates a simple line series for double values
|
|
function CreateDoubleListener(const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5):
|
|
IMycProcessor<TArray<Double>>;
|
|
|
|
// The maximum number of data points to display from the main series.
|
|
property Lookback: Integer read FLookback write FLookback;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Math,
|
|
System.SyncObjs, WinApi.Windows,
|
|
Myc.Trade.DataArray;
|
|
|
|
type
|
|
TChartSeriesProcessor<T> = class(TMycChart.TSeries, IMycProcessor<TArray<T>>)
|
|
strict private
|
|
FDataSeries: TMycDataArray<T>;
|
|
FChanged: Boolean;
|
|
FLock: TSpinLock;
|
|
procedure ProcessData(const Values: TArray<T>);
|
|
private
|
|
FData: TMycDataArray<T>;
|
|
protected
|
|
function GetCount: Int64; override;
|
|
function Update: Boolean; override;
|
|
|
|
public
|
|
constructor Create(AOwner: TMycChart);
|
|
property Data: TMycDataArray<T> read FData;
|
|
end;
|
|
|
|
{ TChartOhlcSeries }
|
|
TChartOhlcSeries = class(TChartSeriesProcessor<TDataPoint<TOhlcItem>>)
|
|
private
|
|
FUpColor: TAlphaColor;
|
|
FDownColor: TAlphaColor;
|
|
FStyle: TCandleStyle;
|
|
protected
|
|
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override;
|
|
procedure Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>); override;
|
|
public
|
|
constructor Create(AOwner: TMycChart; const AUpColor, ADownColor: TAlphaColor; AStyle: TCandleStyle);
|
|
end;
|
|
|
|
{ TChartLineSeries }
|
|
TChartLineSeries = class(TChartSeriesProcessor<Double>)
|
|
private
|
|
FLineColor: TAlphaColor;
|
|
FLineWidth: Single;
|
|
protected
|
|
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override;
|
|
procedure Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>); override;
|
|
public
|
|
constructor Create(AOwner: TMycChart; const ALineColor: TAlphaColor; ALineWidth: Single);
|
|
end;
|
|
|
|
{ TMycChart.TSeries }
|
|
|
|
constructor TMycChart.TSeries.Create(AOwner: TMycChart);
|
|
begin
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
function TMycChart.TSeries.GetMainSeries: TSeries;
|
|
begin
|
|
Result := nil;
|
|
if Owner.FSeriesList.Count > 0 then
|
|
Result := Owner.FSeriesList[0];
|
|
end;
|
|
|
|
function TMycChart.TSeries.GetOwner: TMycChart;
|
|
begin
|
|
Result := Controller as TMycChart;
|
|
end;
|
|
|
|
{ TMycChart }
|
|
|
|
constructor TMycChart.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSeriesList := TObjectList<TSeries>.Create(true);
|
|
FLookback := 100; // Default lookback
|
|
|
|
FIdleSubscrId :=
|
|
TMessageManager
|
|
.DefaultManager
|
|
.SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin DoIdle; end);
|
|
end;
|
|
|
|
destructor TMycChart.Destroy;
|
|
begin
|
|
TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FIdleSubscrId);
|
|
|
|
FSeriesList.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TMycChart.CreateDoubleListener(const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5):
|
|
IMycProcessor<TArray<Double>>;
|
|
var
|
|
series: TChartLineSeries;
|
|
begin
|
|
series := TChartLineSeries.Create(Self, ALineColor, ALineWidth);
|
|
FSeriesList.Add(series);
|
|
Result := series;
|
|
end;
|
|
|
|
function TMycChart.CreateOhlcListener(
|
|
const AUpColor: TAlphaColor = TAlphaColors.Green;
|
|
const ADownColor: TAlphaColor = TAlphaColors.Red;
|
|
const AStyle: TCandleStyle = csCandleStick
|
|
): IMycProcessor<TArray<TDataPoint<TOhlcItem>>>;
|
|
var
|
|
series: TChartOhlcSeries;
|
|
begin
|
|
series := TChartOhlcSeries.Create(Self, AUpColor, ADownColor, AStyle);
|
|
FSeriesList.Add(series);
|
|
Result := series;
|
|
end;
|
|
|
|
procedure TMycChart.DoIdle;
|
|
begin
|
|
var doRepaint := false;
|
|
for var series in FSeriesList do
|
|
if series.Update then
|
|
doRepaint := true;
|
|
if doRepaint then
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TMycChart.Paint;
|
|
var
|
|
rect: TRectF;
|
|
series: TSeries;
|
|
globalMin, globalMax, seriesMin, seriesMax, padding: Double;
|
|
rangeInitialized: Boolean;
|
|
xTransform: TFunc<Double, Single>;
|
|
yTransform: TFunc<Double, Single>;
|
|
begin
|
|
inherited;
|
|
rect := Self.LocalRect;
|
|
|
|
if (FSeriesList.Count = 0) or (FLookback <= 1) then
|
|
begin
|
|
Canvas.Fill.Color := TAlphaColors.Gray;
|
|
Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center);
|
|
Exit;
|
|
end;
|
|
|
|
rangeInitialized := false;
|
|
|
|
for series in FSeriesList do
|
|
begin
|
|
if series.GetValueRange(0, FLookback, seriesMin, seriesMax) then
|
|
begin
|
|
if not rangeInitialized then
|
|
begin
|
|
globalMin := seriesMin;
|
|
globalMax := seriesMax;
|
|
rangeInitialized := true;
|
|
end
|
|
else
|
|
begin
|
|
globalMin := Min(globalMin, seriesMin);
|
|
globalMax := Max(globalMax, seriesMax);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if not rangeInitialized then
|
|
Exit;
|
|
|
|
padding := (globalMax - globalMin) * 0.1;
|
|
globalMin := globalMin - padding;
|
|
globalMax := globalMax + padding;
|
|
|
|
if (globalMax - globalMin) = 0 then
|
|
exit;
|
|
|
|
xTransform := function(index: Double): Single begin Result := rect.Right - (index / (FLookback - 1)) * rect.Width; end;
|
|
|
|
yTransform :=
|
|
function(value: Double): Single
|
|
begin
|
|
Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height;
|
|
end;
|
|
|
|
// var T :=
|
|
// TMatrix.CreateTranslation(rect.Left, rect.Top + rect.Height*globalMax / (globalMax - globalMin)) *
|
|
// TMatrix.CreateScaling(rect.Width / (FLookback - 1), -rect.Height / (globalMax - globalMin));
|
|
|
|
for series in FSeriesList do
|
|
begin
|
|
series.Paint(Self.Canvas, xTransform, yTransform);
|
|
end;
|
|
end;
|
|
|
|
{ TChartSeriesProcessor<T> }
|
|
|
|
constructor TChartSeriesProcessor<T>.Create(AOwner: TMycChart);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FLock := TSpinLock.Create(false);
|
|
FDataSeries := TMycDataArray<T>.CreateEmpty;
|
|
FData := FDataSeries;
|
|
end;
|
|
|
|
function TChartSeriesProcessor<T>.GetCount: Int64;
|
|
begin
|
|
Result := FData.Count;
|
|
end;
|
|
|
|
procedure TChartSeriesProcessor<T>.ProcessData(const Values: TArray<T>);
|
|
begin
|
|
FLock.Enter;
|
|
try
|
|
FDataSeries := FDataSeries.Add(Values, 0, Length(Values), Owner.Lookback);
|
|
FChanged := true;
|
|
finally
|
|
FLock.Exit;
|
|
end;
|
|
end;
|
|
|
|
function TChartSeriesProcessor<T>.Update: Boolean;
|
|
begin
|
|
FLock.Enter;
|
|
try
|
|
Result := FChanged;
|
|
FChanged := false;
|
|
if Result then
|
|
FData := FDataSeries;
|
|
finally
|
|
FLock.Exit;
|
|
end;
|
|
end;
|
|
|
|
{ TChartOhlcSeries }
|
|
|
|
constructor TChartOhlcSeries.Create(AOwner: TMycChart; const AUpColor, ADownColor: TAlphaColor; AStyle: TCandleStyle);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FUpColor := AUpColor;
|
|
FDownColor := ADownColor;
|
|
FStyle := AStyle;
|
|
end;
|
|
|
|
function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean;
|
|
var
|
|
i: Int64;
|
|
begin
|
|
Result := GetCount > 0;
|
|
if not Result then
|
|
Exit;
|
|
|
|
Min := MaxDouble;
|
|
Max := -MaxDouble;
|
|
for i := StartIndex to System.Math.Min(GetCount - 1, StartIndex + Count - 1) do
|
|
begin
|
|
Min := System.Math.Min(Min, Data.Items[i].Data.Low);
|
|
Max := System.Math.Max(Max, Data.Items[i].Data.High);
|
|
end;
|
|
Result := (Min <> MaxDouble);
|
|
end;
|
|
|
|
procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>);
|
|
var
|
|
i, displayCount: Int64;
|
|
x, candleWidth: Single;
|
|
yOpen, yHigh, yLow, yClose: Single;
|
|
item: TDataPoint<TOhlcItem>;
|
|
isUp: boolean;
|
|
begin
|
|
displayCount := System.Math.Min(Data.Count, Owner.Lookback);
|
|
if displayCount <= 0 then
|
|
Exit;
|
|
|
|
if displayCount > 1 then
|
|
candleWidth := Max(2, 0.8 * Abs((AXForm(1) - AXForm(0))))
|
|
else
|
|
candleWidth := 10;
|
|
|
|
for i := 0 to displayCount - 1 do
|
|
begin
|
|
item := Data.Items[i];
|
|
x := AXForm(i);
|
|
yOpen := AYForm(item.Data.Open);
|
|
yClose := AYForm(item.Data.Close);
|
|
yHigh := AYForm(item.Data.High);
|
|
yLow := AYForm(item.Data.Low);
|
|
isUp := item.Data.Close >= item.Data.Open;
|
|
|
|
if isUp then
|
|
ACanvas.Stroke.Color := FUpColor
|
|
else
|
|
ACanvas.Stroke.Color := FDownColor;
|
|
ACanvas.Stroke.Thickness := 1.0;
|
|
|
|
ACanvas.DrawLine(TPointF.Create(x, yHigh), TPointF.Create(x, yLow), 1);
|
|
|
|
if FStyle = csCandleStick then
|
|
begin
|
|
ACanvas.Fill.Color := ACanvas.Stroke.Color;
|
|
if isUp then
|
|
ACanvas.FillRect(TRectF.Create(x - candleWidth / 2, yClose, x + candleWidth / 2, yOpen), 0, 0, AllCorners, 1)
|
|
else
|
|
ACanvas.FillRect(TRectF.Create(x - candleWidth / 2, yOpen, x + candleWidth / 2, yClose), 0, 0, AllCorners, 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TChartLineSeries }
|
|
|
|
constructor TChartLineSeries.Create(AOwner: TMycChart; const ALineColor: TAlphaColor; ALineWidth: Single);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FLineColor := ALineColor;
|
|
FLineWidth := ALineWidth;
|
|
end;
|
|
|
|
function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean;
|
|
var
|
|
i: Int64;
|
|
begin
|
|
Result := GetCount > 0;
|
|
if not Result then
|
|
Exit;
|
|
|
|
Min := MaxDouble;
|
|
Max := -MaxDouble;
|
|
for i := StartIndex to System.Math.Min(GetCount - 1, StartIndex + Count - 1) do
|
|
begin
|
|
Min := System.Math.Min(Min, Data.Items[i]);
|
|
Max := System.Math.Max(Max, Data.Items[i]);
|
|
end;
|
|
Result := (Min <> MaxDouble);
|
|
end;
|
|
|
|
procedure TChartLineSeries.Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>);
|
|
begin
|
|
if not Assigned(MainSeries) or (Data.Count = 0) or (MainSeries.Count = 0) then
|
|
Exit;
|
|
|
|
var points := TPathData.Create;
|
|
|
|
var displayCount := System.Math.Min(Data.Count, Owner.Lookback);
|
|
if displayCount < 2 then
|
|
Exit;
|
|
|
|
points.MoveTo( TPointF.Create(AXForm(0), AYForm(Data[0])) );
|
|
for var i := 1 to displayCount - 1 do
|
|
points.LineTo( TPointF.Create(AXForm(i), AYForm(Data[i])) );
|
|
|
|
ACanvas.Stroke.Color := FLineColor;
|
|
ACanvas.Stroke.Thickness := FLineWidth;
|
|
ACanvas.DrawPath(points, 1);
|
|
end;
|
|
|
|
end.
|