Michael Schimmel
787 lines
23 KiB
ObjectPascal
787 lines
23 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,
|
|
FMX.Forms,
|
|
Myc.Trade.DataPoint,
|
|
Myc.Signals,
|
|
Myc.Lazy;
|
|
|
|
type
|
|
TCandleStyle = (csCandleStick, csHiLoBar);
|
|
|
|
TMycChart = class(TStyledControl)
|
|
public type
|
|
TSeries = class abstract(TObject)
|
|
private
|
|
FOwner: TMycChart;
|
|
function GetMainSeries: TSeries;
|
|
protected
|
|
function GetCount: Int64; virtual; abstract;
|
|
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract;
|
|
function Update: Boolean; virtual; abstract;
|
|
// The signature is changed to support viewport painting
|
|
procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>); virtual; abstract;
|
|
property MainSeries: TSeries read GetMainSeries;
|
|
public
|
|
constructor Create(AOwner: TMycChart);
|
|
property Count: Int64 read GetCount;
|
|
property Owner: TMycChart read FOwner;
|
|
end;
|
|
|
|
private
|
|
FSeriesList: TList<TSeries>;
|
|
FLookback: TWriteable<Int64>;
|
|
FIdleSubscrId: TMessageSubscriptionId;
|
|
FViewStartIndex: Int64;
|
|
FViewCount: Int64;
|
|
FIsDragging: Boolean;
|
|
FDragStartPoint: TPointF;
|
|
FJumpButtonRect: TRectF;
|
|
FJumpButtonHot: Boolean;
|
|
FJumpButtonPressed: Boolean; protected
|
|
procedure Paint; override;
|
|
procedure DoIdle;
|
|
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
// Creates an OHLC candlestick/bar series
|
|
procedure AddOhlcSeries(
|
|
const DataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
|
|
const AUpColor: TAlphaColor = TAlphaColors.Green;
|
|
const ADownColor: TAlphaColor = TAlphaColors.Red;
|
|
const AStyle: TCandleStyle = csCandleStick
|
|
);
|
|
|
|
// Creates a simple line series for double values
|
|
procedure AddDoubleSeries(
|
|
const DataProvider: IMycDataProvider<Double>;
|
|
const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
|
|
const ALineWidth: Single = 1.5
|
|
);
|
|
|
|
property Lookback: TWriteable<Int64> read FLookback write FLookback;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Math,
|
|
System.SyncObjs,
|
|
WinApi.Windows,
|
|
Myc.Trade.DataArray;
|
|
|
|
type
|
|
TChartSeriesReceiver<T> = class(TMycProcessor<T>)
|
|
strict private
|
|
FCurrData: TMycDataArray<T>;
|
|
FLookback: TWriteable<Int64>;
|
|
private
|
|
FData: TWriteable<TMycDataArray<T>>;
|
|
protected
|
|
function ProcessData(const Value: T): Boolean; override;
|
|
procedure Update; override;
|
|
public
|
|
constructor Create(const ALookback: TWriteable<Int64>);
|
|
function GetData(var Data: TMycDataArray<T>): Boolean;
|
|
property Data: TWriteable<TMycDataArray<T>> read FData;
|
|
end;
|
|
|
|
TChartSeriesProcessor<T> = class(TMycChart.TSeries)
|
|
strict private
|
|
FDataSeries: TMycDataArray<T>;
|
|
FLock: TSpinLock;
|
|
private
|
|
FData: TMycDataArray<T>;
|
|
FDataProvider: IMycDataProvider<T>;
|
|
FReceiver: TChartSeriesReceiver<T>;
|
|
FReceiverTag: TTag;
|
|
protected
|
|
function GetCount: Int64; override;
|
|
function Update: Boolean; override;
|
|
|
|
public
|
|
constructor Create(AOwner: TMycChart; const ADataProvider: IMycDataProvider<T>);
|
|
destructor Destroy; override;
|
|
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 MinValue, MaxValue: Double): Boolean; override;
|
|
procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>); override;
|
|
public
|
|
constructor Create(
|
|
AOwner: TMycChart;
|
|
const ADataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
|
|
const AUpColor, ADownColor: TAlphaColor;
|
|
AStyle: TCandleStyle
|
|
);
|
|
end;
|
|
|
|
{ TChartLineSeries }
|
|
TChartLineSeries = class(TChartSeriesProcessor<Double>)
|
|
private
|
|
FLineColor: TAlphaColor;
|
|
FLineWidth: Single;
|
|
protected
|
|
function GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean; override;
|
|
procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>); override;
|
|
public
|
|
constructor Create(
|
|
AOwner: TMycChart;
|
|
const ADataProvider: IMycDataProvider<Double>;
|
|
const ALineColor: TAlphaColor;
|
|
ALineWidth: Single
|
|
);
|
|
end;
|
|
|
|
{ TMycChart.TSeries }
|
|
|
|
constructor TMycChart.TSeries.Create(AOwner: TMycChart);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
function TMycChart.TSeries.GetMainSeries: TSeries;
|
|
begin
|
|
Result := nil;
|
|
if (Owner.FSeriesList.Count > 0) then
|
|
Result := Owner.FSeriesList[0];
|
|
end;
|
|
|
|
{ TMycChart }
|
|
|
|
constructor TMycChart.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSeriesList := TObjectList<TSeries>.Create(true);
|
|
|
|
FLookback := TWriteable<Int64>.CreateWriteable( 1000 ); // Load more data for panning
|
|
FViewStartIndex := 0;
|
|
FViewCount := 100; // Show 100 items by default
|
|
FIsDragging := false;
|
|
|
|
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;
|
|
|
|
procedure TMycChart.AddDoubleSeries(
|
|
const DataProvider: IMycDataProvider<Double>;
|
|
const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
|
|
const ALineWidth: Single = 1.5
|
|
);
|
|
var
|
|
series: TChartLineSeries;
|
|
begin
|
|
series := TChartLineSeries.Create(Self, DataProvider, ALineColor, ALineWidth);
|
|
FSeriesList.Add(series);
|
|
end;
|
|
|
|
procedure TMycChart.AddOhlcSeries(
|
|
const DataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
|
|
const AUpColor: TAlphaColor = TAlphaColors.Green;
|
|
const ADownColor: TAlphaColor = TAlphaColors.Red;
|
|
const AStyle: TCandleStyle = csCandleStick
|
|
);
|
|
var
|
|
series: TChartOhlcSeries;
|
|
begin
|
|
series := TChartOhlcSeries.Create(Self, DataProvider, AUpColor, ADownColor, AStyle);
|
|
FSeriesList.Add(series);
|
|
end;
|
|
|
|
procedure TMycChart.DoIdle;
|
|
var
|
|
doRepaint: Boolean;
|
|
mainSeries: TSeries;
|
|
isLiveView: Boolean;
|
|
prevCount, newCount, newCandles: Int64;
|
|
begin
|
|
if (FSeriesList.Count = 0) then
|
|
begin
|
|
exit;
|
|
end;
|
|
|
|
mainSeries := FSeriesList[0];
|
|
if (mainSeries = nil) then
|
|
begin
|
|
exit;
|
|
end;
|
|
|
|
// Remember state before update
|
|
isLiveView := (FViewStartIndex = 0);
|
|
prevCount := mainSeries.Count;
|
|
|
|
// Check all series for updates
|
|
doRepaint := false;
|
|
for var series in FSeriesList do
|
|
begin
|
|
if series.Update then
|
|
begin
|
|
doRepaint := true;
|
|
end;
|
|
end;
|
|
|
|
if doRepaint then
|
|
begin
|
|
newCount := mainSeries.Count;
|
|
newCandles := newCount - prevCount;
|
|
|
|
// Adjust viewport only if user was not watching the live data
|
|
if (not isLiveView) and (newCandles > 0) then
|
|
begin
|
|
FViewStartIndex := FViewStartIndex + newCandles;
|
|
end;
|
|
// If the view was live, it implicitly stays at StartIndex = 0, showing the new data.
|
|
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
|
begin
|
|
// Check for button press first
|
|
if (Button = TMouseButton.mbLeft) and (FViewStartIndex > 0) and FJumpButtonRect.Contains(PointF(X, Y)) then
|
|
begin
|
|
FJumpButtonPressed := true;
|
|
Repaint;
|
|
exit; // Prevent chart dragging
|
|
end;
|
|
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if (Button = TMouseButton.mbLeft) then
|
|
begin
|
|
FIsDragging := true;
|
|
FDragStartPoint := TPointF.Create(X, Y);
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
|
begin
|
|
// Check if a button press was active
|
|
if FJumpButtonPressed then
|
|
begin
|
|
FJumpButtonPressed := false;
|
|
// If mouse is released over the button, trigger the action
|
|
if (FViewStartIndex > 0) and FJumpButtonRect.Contains(PointF(X, Y)) then
|
|
begin
|
|
FViewStartIndex := 0; // Jump to the latest candle
|
|
end;
|
|
Repaint;
|
|
exit;
|
|
end;
|
|
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
if (Button = TMouseButton.mbLeft) then
|
|
begin
|
|
FIsDragging := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.MouseMove(Shift: TShiftState; X, Y: Single);
|
|
var
|
|
isHot: Boolean;
|
|
dx: Single;
|
|
indexDelta: Int64;
|
|
mainSeries: TSeries;
|
|
maxIndex: Int64;
|
|
begin
|
|
// Update button hot state
|
|
if (FViewStartIndex > 0) then
|
|
begin
|
|
isHot := FJumpButtonRect.Contains(PointF(X, Y));
|
|
if (isHot <> FJumpButtonHot) then
|
|
begin
|
|
FJumpButtonHot := isHot;
|
|
Repaint;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// Ensure hot state is off when button is not visible
|
|
if FJumpButtonHot then
|
|
begin
|
|
FJumpButtonHot := false;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
// Panning logic
|
|
inherited MouseMove(Shift, X, Y);
|
|
if FIsDragging then
|
|
begin
|
|
dx := X - FDragStartPoint.X;
|
|
if Abs(dx) < 2 then // Threshold to avoid jitter
|
|
begin
|
|
exit;
|
|
end;
|
|
|
|
if (FSeriesList.Count = 0) or (FViewCount <= 0) then
|
|
begin
|
|
exit;
|
|
end;
|
|
|
|
indexDelta := Round(dx / (Self.Width / FViewCount));
|
|
|
|
// To move content left (natural), view must shift to newer data (lower index).
|
|
// Drag left (dx < 0) -> FViewStartIndex must decrease.
|
|
// The formula for that is FViewStartIndex := FViewStartIndex + indexDelta; -> StartIndex + (negative) = decrease.
|
|
FViewStartIndex := FViewStartIndex + indexDelta;
|
|
|
|
|
|
// Clamp values
|
|
mainSeries := FSeriesList[0];
|
|
maxIndex := 0;
|
|
if (mainSeries <> nil) then
|
|
begin
|
|
maxIndex := mainSeries.Count - FViewCount;
|
|
end;
|
|
if (maxIndex < 0) then
|
|
begin
|
|
maxIndex := 0;
|
|
end;
|
|
|
|
if (FViewStartIndex < 0) then FViewStartIndex := 0;
|
|
if (FViewStartIndex > maxIndex) then FViewStartIndex := maxIndex;
|
|
|
|
FDragStartPoint := TPointF.Create(X, Y);
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
|
var
|
|
mousePos: TPointF;
|
|
anchorIndex: Double;
|
|
zoomFactor: Double;
|
|
newViewCount: Int64;
|
|
ratio: Double;
|
|
mainSeries: TSeries;
|
|
begin
|
|
Handled := true;
|
|
|
|
if (FSeriesList.Count = 0) then
|
|
begin
|
|
exit;
|
|
end;
|
|
mainSeries := FSeriesList[0];
|
|
if (mainSeries = nil) or (mainSeries.Count = 0) or (Self.Width <= 0) then
|
|
begin
|
|
exit;
|
|
end;
|
|
|
|
mousePos := Self.ScreenToLocal(Screen.MousePos);
|
|
|
|
// Correctly calculate the anchor index for a right-to-left axis
|
|
anchorIndex := FViewStartIndex + ((Self.Width - mousePos.X) / Self.Width) * FViewCount;
|
|
|
|
if (WheelDelta > 0) then
|
|
zoomFactor := 0.8 // Zoom In
|
|
else
|
|
zoomFactor := 1.25; // Zoom Out
|
|
|
|
newViewCount := Round(FViewCount * zoomFactor);
|
|
|
|
// Clamp zoom level
|
|
if (newViewCount < 10) then newViewCount := 10;
|
|
if (newViewCount > mainSeries.Count) then newViewCount := mainSeries.Count;
|
|
if (newViewCount = FViewCount) then exit;
|
|
|
|
// Adjust start index to keep anchor point stable
|
|
if (FViewCount > 0) then
|
|
ratio := (anchorIndex - FViewStartIndex) / FViewCount
|
|
else
|
|
ratio := 0;
|
|
|
|
FViewStartIndex := Round(anchorIndex - (ratio * newViewCount));
|
|
FViewCount := newViewCount;
|
|
|
|
// Clamp start index
|
|
if (FViewStartIndex < 0) then FViewStartIndex := 0;
|
|
if (FViewStartIndex + FViewCount > mainSeries.Count) then
|
|
begin
|
|
FViewStartIndex := mainSeries.Count - FViewCount;
|
|
end;
|
|
|
|
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>;
|
|
isButtonVisible: Boolean;
|
|
buttonColor: TAlphaColor;
|
|
path: TPathData;
|
|
begin
|
|
inherited;
|
|
rect := Self.LocalRect;
|
|
|
|
if (FSeriesList.Count = 0) or (FViewCount <= 1) then
|
|
begin
|
|
Canvas.Fill.Color := TAlphaColors.Gray;
|
|
Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center);
|
|
Exit;
|
|
end;
|
|
|
|
rangeInitialized := false;
|
|
|
|
// Determine value range for the visible viewport only
|
|
for series in FSeriesList do
|
|
begin
|
|
if series.GetValueRange(FViewStartIndex, FViewCount, 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;
|
|
|
|
// Transform maps an index from the viewport to a screen coordinate
|
|
xTransform := function(index: Double): Single
|
|
begin
|
|
if (FViewCount <= 1) then
|
|
begin
|
|
Result := rect.Left + rect.Width / 2;
|
|
exit;
|
|
end;
|
|
Result := rect.Right - (((index - FViewStartIndex) / (FViewCount - 1)) * rect.Width);
|
|
end;
|
|
|
|
yTransform :=
|
|
function(value: Double): Single
|
|
begin
|
|
Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height;
|
|
end;
|
|
|
|
for series in FSeriesList do
|
|
begin
|
|
series.Paint(Self.Canvas, FViewStartIndex, FViewCount, xTransform, yTransform);
|
|
end;
|
|
|
|
// --- Draw the "jump to latest" button ---
|
|
isButtonVisible := (FViewStartIndex > 0);
|
|
FJumpButtonHot := FJumpButtonHot and isButtonVisible;
|
|
|
|
if isButtonVisible then
|
|
begin
|
|
// Define button position and size
|
|
FJumpButtonRect := TRectF.Create(Self.Width - 44, Self.Height - 44, Self.Width - 10, Self.Height - 10);
|
|
|
|
// Determine color based on state
|
|
if FJumpButtonPressed then
|
|
buttonColor := $FF707070 // Pressed color
|
|
else if FJumpButtonHot then
|
|
buttonColor := $FF505050 // Hover color
|
|
else
|
|
buttonColor := $FF303030; // Default color
|
|
|
|
// Draw button background
|
|
Canvas.Fill.Color := buttonColor;
|
|
Canvas.FillRect(FJumpButtonRect, 4, 4, AllCorners, 0.7);
|
|
|
|
// Draw an icon (e.g., a "fast forward" double arrow)
|
|
Canvas.Stroke.Color := TAlphaColors.White;
|
|
Canvas.Stroke.Thickness := 1.5;
|
|
|
|
path := TPathData.Create;
|
|
try
|
|
var cx := FJumpButtonRect.CenterPoint.X;
|
|
var cy := FJumpButtonRect.CenterPoint.Y;
|
|
// First arrow
|
|
path.MoveTo(PointF(cx - 5, cy - 6));
|
|
path.LineTo(PointF(cx, cy));
|
|
path.LineTo(PointF(cx - 5, cy + 6));
|
|
// Second arrow
|
|
path.MoveTo(PointF(cx + 2, cy - 6));
|
|
path.LineTo(PointF(cx + 7, cy));
|
|
path.LineTo(PointF(cx + 2, cy + 6));
|
|
Canvas.DrawPath(path, 1);
|
|
finally
|
|
path.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// Reset button state when not visible
|
|
FJumpButtonRect := TRectF.Empty;
|
|
FJumpButtonPressed := false;
|
|
end;
|
|
end;
|
|
|
|
{ TChartSeriesProcessor<T> }
|
|
|
|
constructor TChartSeriesProcessor<T>.Create(AOwner: TMycChart; const ADataProvider: IMycDataProvider<T>);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FLock := TSpinLock.Create(false);
|
|
FDataSeries := TMycDataArray<T>.CreateEmpty;
|
|
FData := FDataSeries;
|
|
FDataProvider := ADataProvider;
|
|
FReceiver := TChartSeriesReceiver<T>.Create(AOwner.FLookback);
|
|
FReceiverTag := FDataProvider.Link(FReceiver);
|
|
end;
|
|
|
|
destructor TChartSeriesProcessor<T>.Destroy;
|
|
begin
|
|
FDataProvider.Unlink(FReceiverTag);
|
|
inherited;
|
|
end;
|
|
|
|
function TChartSeriesProcessor<T>.GetCount: Int64;
|
|
begin
|
|
Result := FData.Count;
|
|
end;
|
|
|
|
function TChartSeriesProcessor<T>.Update: Boolean;
|
|
begin
|
|
Result := FReceiver.GetData(FData);
|
|
end;
|
|
|
|
{ TChartOhlcSeries }
|
|
|
|
constructor TChartOhlcSeries.Create(
|
|
AOwner: TMycChart;
|
|
const ADataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
|
|
const AUpColor, ADownColor: TAlphaColor;
|
|
AStyle: TCandleStyle
|
|
);
|
|
begin
|
|
inherited Create(AOwner, ADataProvider);
|
|
FUpColor := AUpColor;
|
|
FDownColor := ADownColor;
|
|
FStyle := AStyle;
|
|
end;
|
|
|
|
function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
|
|
var
|
|
i: Int64;
|
|
lastIndex: Int64;
|
|
begin
|
|
Result := GetCount > 0;
|
|
if not Result then
|
|
Exit;
|
|
|
|
MinValue := MaxDouble;
|
|
MaxValue := -MaxDouble;
|
|
lastIndex := Min(GetCount - 1, StartIndex + Count - 1);
|
|
|
|
for i := StartIndex to lastIndex do
|
|
begin
|
|
var dp := Data.Items[i];
|
|
MinValue := Min(MinValue, dp.Data.Low);
|
|
MaxValue := Max(MaxValue, dp.Data.High);
|
|
end;
|
|
Result := (MinValue <> MaxDouble);
|
|
end;
|
|
|
|
procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>);
|
|
var
|
|
i: Int64;
|
|
lastIndex: Int64;
|
|
x, candleWidth: Single;
|
|
yOpen, yHigh, yLow, yClose: Single;
|
|
item: TDataPoint<TOhlcItem>;
|
|
isUp: boolean;
|
|
begin
|
|
if (Count <= 0) then
|
|
Exit;
|
|
|
|
if (Count > 1) then
|
|
candleWidth := Max(2, 0.8 * Abs((AXForm(StartIndex + 1) - AXForm(StartIndex))))
|
|
else
|
|
candleWidth := 10;
|
|
|
|
lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
|
|
for i := StartIndex to lastIndex 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 ADataProvider: IMycDataProvider<Double>;
|
|
const ALineColor: TAlphaColor;
|
|
ALineWidth: Single
|
|
);
|
|
begin
|
|
inherited Create(AOwner, ADataProvider);
|
|
FLineColor := ALineColor;
|
|
FLineWidth := ALineWidth;
|
|
end;
|
|
|
|
function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
|
|
var
|
|
i: Int64;
|
|
lastIndex: Int64;
|
|
begin
|
|
Result := GetCount > 0;
|
|
if not Result then
|
|
Exit;
|
|
|
|
MinValue := MaxDouble;
|
|
MaxValue := -MaxDouble;
|
|
lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
|
|
for i := StartIndex to lastIndex do
|
|
begin
|
|
var v := Data.Items[i];
|
|
if not IsNaN(v) then
|
|
begin
|
|
MinValue := Min(MinValue, v);
|
|
MaxValue := Max(MaxValue, v);
|
|
end;
|
|
end;
|
|
Result := (MinValue <> MaxDouble);
|
|
end;
|
|
|
|
procedure TChartLineSeries.Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>);
|
|
var
|
|
points: TPathData;
|
|
i, n: Int64;
|
|
lastIndex: Int64;
|
|
begin
|
|
if (Data.Count = 0) or (Count < 2) then
|
|
Exit;
|
|
|
|
lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
|
|
points := TPathData.Create;
|
|
try
|
|
// Skip warmup data
|
|
n := StartIndex;
|
|
while (n <= lastIndex) and (IsNaN(Data[n])) do
|
|
begin
|
|
inc(n);
|
|
end;
|
|
|
|
if (n > lastIndex) then
|
|
exit;
|
|
|
|
points.MoveTo(TPointF.Create(AXForm(n), AYForm(Data[n])));
|
|
for i := n + 1 to lastIndex do
|
|
begin
|
|
if not IsNaN(Data[i]) then
|
|
begin
|
|
points.LineTo(TPointF.Create(AXForm(i), AYForm(Data[i])));
|
|
end;
|
|
end;
|
|
|
|
ACanvas.Stroke.Color := FLineColor;
|
|
ACanvas.Stroke.Thickness := FLineWidth;
|
|
ACanvas.DrawPath(points, 1);
|
|
finally
|
|
points.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TChartSeriesReceiver<T> }
|
|
|
|
constructor TChartSeriesReceiver<T>.Create(const ALookback: TWriteable<Int64>);
|
|
begin
|
|
inherited Create;
|
|
FLookback := ALookback;
|
|
FCurrData := TMycDataArray<T>.CreateEmpty;
|
|
FData := TWriteable<TMycDataArray<T>>.CreateWriteable( FCurrData ).Protect;
|
|
end;
|
|
|
|
function TChartSeriesReceiver<T>.GetData(var Data: TMycDataArray<T>): Boolean;
|
|
begin
|
|
var prevTotalCount := Data.TotalCount;
|
|
Data := FData.Value;
|
|
Result := prevTotalCount <> Data.TotalCount;
|
|
end;
|
|
|
|
function TChartSeriesReceiver<T>.ProcessData(const Value: T): Boolean;
|
|
begin
|
|
Result := true;
|
|
FCurrData := FCurrData.Add(Value, FLookback.Value);
|
|
end;
|
|
|
|
procedure TChartSeriesReceiver<T>.Update;
|
|
begin
|
|
FData.Value := FCurrData;
|
|
end;
|
|
|
|
end.
|