Michael Schimmel
890 lines
28 KiB
ObjectPascal
890 lines
28 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.Types,
|
|
Myc.Trade.DataPoint,
|
|
Myc.Signals,
|
|
Myc.Mutable;
|
|
|
|
type
|
|
TMycChart = class(TStyledControl)
|
|
public
|
|
type
|
|
TPanel = class;
|
|
|
|
// Abstract base for a drawable layer in a panel.
|
|
TLayer = class abstract(TObject)
|
|
protected
|
|
function GetCount: Int64; virtual; abstract;
|
|
function GetTotalCount: Int64; virtual; abstract;
|
|
function GetOwner: TMycChart; virtual; abstract;
|
|
function Update: Boolean; virtual; abstract;
|
|
public
|
|
procedure Repaint;
|
|
property Count: Int64 read GetCount;
|
|
property TotalCount: Int64 read GetTotalCount;
|
|
property Owner: TMycChart read GetOwner;
|
|
end;
|
|
|
|
TDataLayer = class abstract(TLayer)
|
|
private
|
|
FParent: TPanel;
|
|
protected
|
|
function GetOwner: TMycChart; override; final;
|
|
function GetValueRange(First, Last: Int64; out Min, Max: Double): Boolean; virtual; abstract;
|
|
procedure Paint(
|
|
const Canvas: TCanvas;
|
|
First, Last: Int64;
|
|
const XForm: TFunc<Int64, Single>;
|
|
const YForm: TFunc<Double, Single>
|
|
); virtual; abstract;
|
|
public
|
|
constructor Create(AParent: TPanel);
|
|
end;
|
|
|
|
TDragPoint = record
|
|
Point: TPointF;
|
|
Idx: Int64;
|
|
BarX: Single;
|
|
end;
|
|
|
|
TAxisLayer = class abstract(TLayer)
|
|
private
|
|
FOwner: TMycChart;
|
|
protected
|
|
function GetOwner: TMycChart; override; final;
|
|
// Paint crosshair and other axis related overlays
|
|
procedure Paint(const Canvas: TCanvas; const Viewport: TRectF; const MousePos: TDragPoint); virtual; abstract;
|
|
public
|
|
constructor Create(AOwner: TMycChart);
|
|
end;
|
|
|
|
TXAxisLayer = class(TAxisLayer)
|
|
protected
|
|
// Paint crosshair and time caption
|
|
procedure Paint(const Canvas: TCanvas; const Viewport: TRectF; const MousePos: TDragPoint); override;
|
|
// This function delivers the text for the caption.
|
|
function GetCaption(Idx: Int64): String; virtual; abstract;
|
|
end;
|
|
|
|
// A panel is a rectangular area in the chart with its own Y-axis, which can contain multiple layers.
|
|
TPanel = class(TObject)
|
|
private
|
|
FOwner: TMycChart;
|
|
FLayers: TObjectList<TMycChart.TDataLayer>;
|
|
FWeight: Single;
|
|
procedure SetWeight(const Value: Single);
|
|
protected
|
|
procedure Paint(const Canvas: TCanvas; const Viewport: TRectF; MasterTotalCount: Int64; ViewStartIndex, ViewCount: Int64);
|
|
function Update: Boolean;
|
|
|
|
public
|
|
constructor Create(AOwner: TMycChart; AWeight: Single);
|
|
destructor Destroy; override;
|
|
|
|
function AddOhlcSeries(
|
|
const DataProvider: TDataProvider<TOhlcItem>;
|
|
const AUpColor: TAlphaColor = TAlphaColors.Green;
|
|
const ADownColor: TAlphaColor = TAlphaColors.Red
|
|
): TMycChart.TDataLayer;
|
|
|
|
function AddDoubleSeries(
|
|
const DataProvider: TDataProvider<Double>;
|
|
const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
|
|
const ALineWidth: Single = 1.5
|
|
): TMycChart.TDataLayer;
|
|
|
|
property Owner: TMycChart read FOwner;
|
|
property Weight: Single read FWeight write SetWeight;
|
|
end;
|
|
|
|
private
|
|
FPanelList: TObjectList<TPanel>;
|
|
FXAxisSeries: TMycChart.TXAxisLayer;
|
|
FLookback: TWriteable<Int64>;
|
|
FIdleSubscrId: TMessageSubscriptionId;
|
|
FViewStartIndex: Int64;
|
|
FViewCount: Int64;
|
|
FIsDragging: Boolean;
|
|
FMousePos: TDragPoint;
|
|
FDragStartPoint: TDragPoint;
|
|
FIsMouseInControl: Boolean;
|
|
FJumpButtonRect: TRectF;
|
|
FJumpButtonHot: Boolean;
|
|
FJumpButtonPressed: Boolean;
|
|
FNeedRepaint: TFlag;
|
|
FIsResizing: Boolean;
|
|
FResizePanelIndex: Integer;
|
|
FHotResizePanelIndex: Integer;
|
|
function GetPanel(Index: Integer): TPanel;
|
|
function GetPanelCount: Integer;
|
|
function CreateDragPoint(X, Y: Single): TDragPoint;
|
|
protected
|
|
procedure Paint; override;
|
|
procedure DoIdle;
|
|
function Update: Boolean;
|
|
procedure DoMouseLeave; override;
|
|
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;
|
|
|
|
// Adds a new, empty panel to the bottom of the chart.
|
|
function AddPanel: TPanel;
|
|
|
|
// Sets the master series that defines the time scale (X-axis).
|
|
function SetXAxisSeries(Timeframe: TTimeframe; const DataProvider: TDataProvider<TDateTime>): TMycChart.TXAxisLayer; overload;
|
|
function SetXAxisCounter<T>(const DataProvider: TDataProvider<T>): TMycChart.TXAxisLayer; overload;
|
|
|
|
property Lookback: TWriteable<Int64> read FLookback write FLookback;
|
|
property NeedRepaint: TFlag read FNeedRepaint;
|
|
property PanelCount: Integer read GetPanelCount;
|
|
property Panels[Index: Integer]: TPanel read GetPanel; default;
|
|
// The rectangle occupied by the jump-to-latest button, used for hit testing.
|
|
property JumpButtonRect: TRectF read FJumpButtonRect;
|
|
property ViewCount: Int64 read FViewCount;
|
|
property ViewStartIndex: Int64 read FViewStartIndex;
|
|
property XAxisSeries: TMycChart.TXAxisLayer read FXAxisSeries;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Math,
|
|
Myc.FMX.Chart.Series;
|
|
|
|
const
|
|
RESIZE_HOT_ZONE = 4;
|
|
MIN_PANEL_HEIGHT = 30;
|
|
MIN_PANEL_WEIGHT = 0.05;
|
|
|
|
{ TMycChart }
|
|
|
|
constructor TMycChart.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FPanelList := TObjectList<TPanel>.Create(true);
|
|
FXAxisSeries := nil;
|
|
|
|
FLookback := TWriteable<Int64>.CreateWriteable(1000);
|
|
FViewStartIndex := 0;
|
|
FViewCount := 100;
|
|
|
|
FIsDragging := false;
|
|
FIsResizing := false;
|
|
FResizePanelIndex := -1;
|
|
FHotResizePanelIndex := -1;
|
|
FIsMouseInControl := false;
|
|
|
|
FNeedRepaint := TFlag.CreateFlag();
|
|
|
|
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);
|
|
|
|
FXAxisSeries.Free;
|
|
FPanelList.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TMycChart.AddPanel: TPanel;
|
|
begin
|
|
Result := TPanel.Create(Self, IfThen(FPanelList.Count = 0, 1, 0.2));
|
|
FPanelList.Add(Result);
|
|
Repaint;
|
|
end;
|
|
|
|
function TMycChart.CreateDragPoint(X, Y: Single): TDragPoint;
|
|
begin
|
|
var rect := LocalRect;
|
|
|
|
Result.Point.X := X;
|
|
Result.Point.Y := Y;
|
|
Result.Idx := Round((rect.Right - X) * (FViewCount - 1) / rect.Width);
|
|
if (Result.Idx < 0) or (Result.Idx >= FXAxisSeries.Count) then
|
|
Result.Idx := -1;
|
|
Result.BarX := NaN;
|
|
if Result.Idx >= 0 then
|
|
Result.BarX := rect.Right - (Result.Idx * (FViewCount - 1)) / (FViewCount - 1) * (rect.Width / (FViewCount - 1));
|
|
end;
|
|
|
|
function TMycChart.GetPanel(Index: Integer): TPanel;
|
|
begin
|
|
Result := FPanelList[Index];
|
|
end;
|
|
|
|
function TMycChart.GetPanelCount: Integer;
|
|
begin
|
|
Result := FPanelList.Count;
|
|
end;
|
|
|
|
procedure TMycChart.DoIdle;
|
|
begin
|
|
if Update then
|
|
Repaint;
|
|
end;
|
|
|
|
function TMycChart.Update: Boolean;
|
|
begin
|
|
if not Assigned(FXAxisSeries) then
|
|
exit(false);
|
|
|
|
var prevTotalCount := FXAxisSeries.TotalCount;
|
|
var seriesChanged := false;
|
|
|
|
if FXAxisSeries.Update then
|
|
seriesChanged := (FViewStartIndex = 0);
|
|
|
|
for var panel in FPanelList do
|
|
begin
|
|
if panel.Update then
|
|
seriesChanged := true;
|
|
end;
|
|
|
|
// When we are not displaying live data, adjust start index accordingly
|
|
if FViewStartIndex > 0 then
|
|
begin
|
|
var newTotalCount := FXAxisSeries.TotalCount;
|
|
var countDelta := newTotalCount - prevTotalCount;
|
|
if countDelta > 0 then
|
|
begin
|
|
FViewStartIndex := FViewStartIndex + countDelta;
|
|
if (FViewStartIndex + FViewCount > newTotalCount) then
|
|
FViewStartIndex := newTotalCount - FViewCount;
|
|
end;
|
|
end;
|
|
|
|
var repaintSignal := FNeedRepaint.Reset;
|
|
|
|
Result := repaintSignal or seriesChanged;
|
|
end;
|
|
|
|
procedure TMycChart.DoMouseLeave;
|
|
begin
|
|
inherited;
|
|
if FIsMouseInControl then
|
|
begin
|
|
FIsMouseInControl := false;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.Paint;
|
|
var
|
|
rect, panelRect: TRectF;
|
|
isButtonVisible: Boolean;
|
|
buttonColor: TAlphaColor;
|
|
path: TPathData;
|
|
masterTotalCount: Int64;
|
|
panelHeight, totalWeight: Double;
|
|
currentY: Single;
|
|
begin
|
|
inherited;
|
|
rect := Self.LocalRect;
|
|
|
|
if (not Assigned(FXAxisSeries)) or (FXAxisSeries.Count <= 1) or (FViewCount <= 1) or (PanelCount = 0) then
|
|
begin
|
|
Canvas.Fill.Color := TAlphaColors.Gray;
|
|
Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center);
|
|
Exit;
|
|
end;
|
|
|
|
masterTotalCount := FXAxisSeries.TotalCount;
|
|
|
|
// Calculate total weight for proportional panel height
|
|
totalWeight := 0;
|
|
for var panel in FPanelList do
|
|
totalWeight := totalWeight + panel.Weight;
|
|
if (totalWeight <= 0) then
|
|
totalWeight := PanelCount; // Fallback to equal distribution
|
|
|
|
currentY := rect.Top;
|
|
for var i := 0 to PanelCount - 1 do
|
|
begin
|
|
var panel := Panels[i];
|
|
|
|
panelHeight := panel.Weight * rect.Height / totalWeight;
|
|
panelRect := TRectF.Create(rect.Left, currentY, rect.Right, currentY + panelHeight);
|
|
|
|
// Draw panel content
|
|
panel.Paint(Self.Canvas, panelRect, masterTotalCount, FViewStartIndex, FViewCount);
|
|
|
|
// Draw separator line
|
|
if (i > 0) then
|
|
begin
|
|
Canvas.Stroke.Color := TAlphaColors.Gray;
|
|
Canvas.Stroke.Thickness := 1;
|
|
Canvas.DrawLine(PointF(panelRect.Left, panelRect.Top), PointF(panelRect.Right, panelRect.Top), 1);
|
|
end;
|
|
|
|
currentY := currentY + panelHeight;
|
|
end;
|
|
|
|
// Draw crosshair if mouse is in control
|
|
if FIsMouseInControl and Assigned(FXAxisSeries) and (FMousePos.Idx >= 0) then
|
|
begin
|
|
// Do not draw crosshair if mouse is over the jump button
|
|
if not FJumpButtonRect.Contains(FMousePos.Point) then
|
|
FXAxisSeries.Paint(Self.Canvas, rect, FMousePos);
|
|
end;
|
|
|
|
// --- Draw the "jump to latest" button (code unchanged) ---
|
|
isButtonVisible := (FViewStartIndex > 0);
|
|
|
|
if isButtonVisible then
|
|
begin
|
|
FJumpButtonRect := TRectF.Create(Self.Width - 44, Self.Height - 44, Self.Width - 10, Self.Height - 10);
|
|
|
|
if FJumpButtonPressed then
|
|
buttonColor := $FF707070
|
|
else if FJumpButtonHot then
|
|
buttonColor := $FF505050
|
|
else
|
|
buttonColor := $FF303030;
|
|
|
|
Canvas.Fill.Color := buttonColor;
|
|
Canvas.FillRect(FJumpButtonRect, 4, 4, AllCorners, 0.7);
|
|
|
|
Canvas.Stroke.Color := TAlphaColors.White;
|
|
Canvas.Stroke.Thickness := 1.5;
|
|
|
|
path := TPathData.Create;
|
|
try
|
|
var cx := FJumpButtonRect.CenterPoint.X;
|
|
var cy := FJumpButtonRect.CenterPoint.Y;
|
|
path.MoveTo(PointF(cx - 5, cy - 6));
|
|
path.LineTo(PointF(cx, cy));
|
|
path.LineTo(PointF(cx - 5, cy + 6));
|
|
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
|
|
FJumpButtonRect := TRectF.Empty;
|
|
FJumpButtonPressed := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
|
|
// Check for button press first
|
|
if (Button = TMouseButton.mbLeft) and (FViewStartIndex > 0) and FJumpButtonRect.Contains(PointF(X, Y)) then
|
|
begin
|
|
FJumpButtonPressed := true;
|
|
Repaint;
|
|
exit;
|
|
end;
|
|
|
|
// Check for starting a resize
|
|
if (Button = TMouseButton.mbLeft) and (FHotResizePanelIndex >= 0) then
|
|
begin
|
|
FIsResizing := true;
|
|
FResizePanelIndex := FHotResizePanelIndex;
|
|
FDragStartPoint := CreateDragPoint(X, Y);
|
|
Capture;
|
|
exit;
|
|
end;
|
|
|
|
if (Button = TMouseButton.mbLeft) then
|
|
begin
|
|
FIsDragging := true;
|
|
FDragStartPoint := CreateDragPoint(X, Y);
|
|
Capture;
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
|
|
if (Button = TMouseButton.mbLeft) then
|
|
begin
|
|
// Stop resizing
|
|
if FIsResizing then
|
|
begin
|
|
FIsResizing := false;
|
|
FResizePanelIndex := -1;
|
|
// Force cursor update on next move by resetting hot index
|
|
if (FHotResizePanelIndex <> -1) then
|
|
begin
|
|
FHotResizePanelIndex := -1;
|
|
Self.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
|
|
// Stop panning
|
|
FIsDragging := false;
|
|
|
|
// Stop button press
|
|
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;
|
|
end;
|
|
|
|
// Release mouse capture if it was held by this control
|
|
ReleaseCapture;
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.MouseMove(Shift: TShiftState; X, Y: Single);
|
|
var
|
|
indexDelta: Int64;
|
|
maxIndex: Int64;
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
|
|
if not FIsMouseInControl then
|
|
FIsMouseInControl := true;
|
|
FMousePos := CreateDragPoint(X, Y);
|
|
|
|
// --- Panel Resizing Logic ---
|
|
if FIsResizing then
|
|
begin
|
|
var dy := FMousePos.Point.Y - FDragStartPoint.Point.Y;
|
|
if Abs(dy) < 2 then // Threshold to avoid jitter
|
|
exit;
|
|
|
|
var panel1 := Panels[FResizePanelIndex];
|
|
var panel2 := Panels[FResizePanelIndex + 1];
|
|
|
|
// Get total weight and height of the two panels being resized
|
|
var totalWeight := 0.0;
|
|
for var panel in FPanelList do
|
|
totalWeight := totalWeight + panel.Weight;
|
|
if (totalWeight <= 0) then
|
|
totalWeight := PanelCount;
|
|
|
|
var h1 := (panel1.Weight / totalWeight) * Self.Height;
|
|
var h2 := (panel2.Weight / totalWeight) * Self.Height;
|
|
var twoPanelWeight := panel1.Weight + panel2.Weight;
|
|
|
|
var newH1 := h1 + dy;
|
|
var newH2 := h2 - dy;
|
|
|
|
// Clamp to minimum height
|
|
if (newH1 < MIN_PANEL_HEIGHT) then
|
|
begin
|
|
newH2 := newH2 + (newH1 - MIN_PANEL_HEIGHT);
|
|
newH1 := MIN_PANEL_HEIGHT;
|
|
end;
|
|
if (newH2 < MIN_PANEL_HEIGHT) then
|
|
begin
|
|
newH1 := newH1 + (newH2 - MIN_PANEL_HEIGHT);
|
|
newH2 := MIN_PANEL_HEIGHT;
|
|
end;
|
|
|
|
// Recalculate weights based on new clamped heights
|
|
if (newH1 + newH2 > 0) then
|
|
begin
|
|
panel1.Weight := (newH1 / (newH1 + newH2)) * twoPanelWeight;
|
|
panel2.Weight := (newH2 / (newH1 + newH2)) * twoPanelWeight;
|
|
end;
|
|
|
|
FDragStartPoint := CreateDragPoint(FDragStartPoint.Point.X, Y); // Update start point for next move
|
|
Repaint;
|
|
exit; // Do not continue with other mouse move logic
|
|
end;
|
|
|
|
// --- Chart Panning Logic ---
|
|
if FIsDragging then
|
|
begin
|
|
if Abs(FMousePos.Point.X - FDragStartPoint.Point.X) < 2 then // Threshold to avoid jitter
|
|
exit;
|
|
|
|
if not Assigned(FXAxisSeries) or (FViewCount <= 0) then
|
|
exit;
|
|
|
|
indexDelta := FMousePos.Idx - FDragStartPoint.Idx;
|
|
FDragStartPoint.Idx := FDragStartPoint.Idx + indexDelta;
|
|
|
|
FViewStartIndex := FViewStartIndex - indexDelta;
|
|
|
|
// Clamp values
|
|
maxIndex := FXAxisSeries.Count - FViewCount;
|
|
if (maxIndex < 0) then
|
|
maxIndex := 0;
|
|
if (FViewStartIndex < 0) then
|
|
FViewStartIndex := 0;
|
|
if (FViewStartIndex > maxIndex) then
|
|
FViewStartIndex := maxIndex;
|
|
|
|
Repaint;
|
|
exit;
|
|
end;
|
|
|
|
// --- Separator Hit-Testing and Cursor Change ---
|
|
var currentHotIndex := -1;
|
|
if (PanelCount > 1) then
|
|
begin
|
|
var totalWeight := 0.0;
|
|
for var panel in FPanelList do
|
|
totalWeight := totalWeight + panel.Weight;
|
|
if (totalWeight <= 0) then
|
|
totalWeight := PanelCount;
|
|
|
|
var currentY: Single := 0;
|
|
for var i := 0 to PanelCount - 2 do
|
|
begin
|
|
currentY := currentY + (Panels[i].Weight / totalWeight) * Self.Height;
|
|
if (Abs(Y - currentY) < RESIZE_HOT_ZONE) then
|
|
begin
|
|
currentHotIndex := i;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if (currentHotIndex <> FHotResizePanelIndex) then
|
|
begin
|
|
FHotResizePanelIndex := currentHotIndex;
|
|
if (FHotResizePanelIndex <> -1) then
|
|
Self.Cursor := crVSplit
|
|
else
|
|
Self.Cursor := crDefault;
|
|
end;
|
|
|
|
// --- Jump Button Hot State Logic and final repaint for crosshair ---
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TMycChart.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
|
var
|
|
zoomFactor: Double;
|
|
newViewCount: Int64;
|
|
begin
|
|
inherited MouseWheel(Shift, WheelDelta, Handled);
|
|
|
|
Handled := true;
|
|
|
|
// An X-axis series is required for zooming
|
|
if not Assigned(FXAxisSeries) then
|
|
exit;
|
|
|
|
var xAxisCount := FXAxisSeries.Count;
|
|
if (xAxisCount = 0) or (Width <= 0) then
|
|
exit;
|
|
|
|
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 > xAxisCount) then
|
|
newViewCount := xAxisCount;
|
|
if (newViewCount = FViewCount) then
|
|
exit;
|
|
|
|
FViewCount := newViewCount;
|
|
|
|
var oldIdx := FViewStartIndex + FMousePos.Idx;
|
|
FMousePos := CreateDragPoint(FMousePos.Point.X, FMousePos.Point.Y);
|
|
FViewStartIndex := oldIdx - FMousePos.Idx;
|
|
|
|
// Clamp start index
|
|
if (FViewStartIndex < 0) then
|
|
FViewStartIndex := 0;
|
|
if (FViewStartIndex + FViewCount > xAxisCount) then
|
|
begin
|
|
FViewStartIndex := xAxisCount - FViewCount;
|
|
end;
|
|
|
|
Repaint;
|
|
end;
|
|
|
|
function TMycChart.SetXAxisCounter<T>(const DataProvider: TDataProvider<T>): TMycChart.TXAxisLayer;
|
|
begin
|
|
FXAxisSeries.Free;
|
|
|
|
var counter := TConverter.CreateCounter<T>;
|
|
DataProvider.Link(counter);
|
|
FXAxisSeries := TChartXAxisLayer<Int64>.Create(Self, counter.Sender);
|
|
Result := FXAxisSeries;
|
|
end;
|
|
|
|
function TMycChart.SetXAxisSeries(Timeframe: TTimeframe; const DataProvider: TDataProvider<TDateTime>): TMycChart.TXAxisLayer;
|
|
begin
|
|
FXAxisSeries.Free;
|
|
|
|
FXAxisSeries := TChartXAxisTimestampLayer.Create(Self, Timeframe, DataProvider);
|
|
Result := FXAxisSeries;
|
|
end;
|
|
|
|
procedure TMycChart.TLayer.Repaint;
|
|
begin
|
|
Owner.Repaint;
|
|
end;
|
|
|
|
{ TMycChart.TPanel }
|
|
|
|
constructor TMycChart.TPanel.Create(AOwner: TMycChart; AWeight: Single);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
FLayers := TObjectList<TMycChart.TDataLayer>.Create(true);
|
|
FWeight := AWeight;
|
|
end;
|
|
|
|
destructor TMycChart.TPanel.Destroy;
|
|
begin
|
|
FLayers.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TMycChart.TPanel.AddDoubleSeries(
|
|
const DataProvider: TDataProvider<Double>;
|
|
const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
|
|
const ALineWidth: Single = 1.5
|
|
): TMycChart.TDataLayer;
|
|
begin
|
|
Result := TChartLineLayer.Create(Self, DataProvider, ALineColor, ALineWidth);
|
|
FLayers.Add(Result);
|
|
end;
|
|
|
|
function TMycChart.TPanel.AddOhlcSeries(
|
|
const DataProvider: TDataProvider<TOhlcItem>;
|
|
const AUpColor: TAlphaColor = TAlphaColors.Green;
|
|
const ADownColor: TAlphaColor = TAlphaColors.Red
|
|
): TMycChart.TDataLayer;
|
|
begin
|
|
Result :=
|
|
TChartOhlcLayer.Create(Self, DataProvider, TMutable<TAlphaColor>.Constant(AUpColor), TMutable<TAlphaColor>.Constant(ADownColor));
|
|
FLayers.Add(Result);
|
|
end;
|
|
|
|
procedure TMycChart.TPanel.Paint(const Canvas: TCanvas; const Viewport: TRectF; MasterTotalCount, ViewStartIndex, ViewCount: Int64);
|
|
var
|
|
localMin, localMax, seriesMin, seriesMax: Double;
|
|
rangeInitialized: Boolean;
|
|
seriesFirst, seriesLast: Int64;
|
|
xTransform: TFunc<Int64, Single>;
|
|
yTransform: TFunc<Double, Single>;
|
|
|
|
function CalcView(Layer: TMycChart.TDataLayer; out First, Last: Int64): Boolean;
|
|
var
|
|
seriesTotalCount, offset, startIdx: Int64;
|
|
begin
|
|
seriesTotalCount := Layer.TotalCount;
|
|
offset := MasterTotalCount - seriesTotalCount;
|
|
startIdx := ViewStartIndex - offset;
|
|
|
|
First := Max(0, startIdx);
|
|
Last := Min(Layer.Count, startIdx + ViewCount) - 1;
|
|
Result := First <= Last;
|
|
end;
|
|
|
|
begin
|
|
rangeInitialized := false;
|
|
localMin := 0;
|
|
localMax := 0;
|
|
|
|
// Update data state
|
|
for var layer in FLayers do
|
|
layer.Update;
|
|
|
|
// 1. Calculate value range (Y-Axis) for this panel only
|
|
for var layer in FLayers do
|
|
begin
|
|
if CalcView(layer, seriesFirst, seriesLast) then
|
|
begin
|
|
if layer.GetValueRange(seriesFirst, seriesLast, seriesMin, seriesMax) then
|
|
begin
|
|
if not rangeInitialized then
|
|
begin
|
|
localMin := seriesMin;
|
|
localMax := seriesMax;
|
|
rangeInitialized := true;
|
|
end
|
|
else
|
|
begin
|
|
localMin := Min(localMin, seriesMin);
|
|
localMax := Max(localMax, seriesMax);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if not rangeInitialized then
|
|
Exit; // Nothing to draw in this panel
|
|
|
|
if (localMax - localMin) = 0 then
|
|
localMax := localMin + 1; // Avoid division by zero
|
|
|
|
// 2. Create transforms for this panel
|
|
const padding = 2;
|
|
var top: Double := Viewport.Top + padding;
|
|
var height: Double := Viewport.Height - (2 * padding);
|
|
var range: Double := localMax - localMin;
|
|
yTransform := function(value: Double): Single begin Result := top + (1 - (value - localMin) / range) * height; end;
|
|
|
|
// 3. Paint all layers in this panel
|
|
for var layer in FLayers do
|
|
begin
|
|
if CalcView(layer, seriesFirst, seriesLast) then
|
|
begin
|
|
var offset := MasterTotalCount - layer.TotalCount;
|
|
xTransform :=
|
|
function(index: Int64): Single
|
|
begin
|
|
Result := Viewport.Right - (((index + offset - ViewStartIndex) / (ViewCount - 1)) * Viewport.Width);
|
|
end;
|
|
|
|
layer.Paint(Canvas, seriesFirst, seriesLast, xTransform, yTransform);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMycChart.TPanel.SetWeight(const Value: Single);
|
|
begin
|
|
// Ensure weight does not become too small or negative
|
|
var clampedValue := Max(MIN_PANEL_WEIGHT, Value);
|
|
if FWeight <> clampedValue then
|
|
begin
|
|
FWeight := clampedValue;
|
|
// Do not call Repaint here, it will be handled by the mouse move logic
|
|
if Assigned(FOwner) and (not FOwner.FIsResizing) then
|
|
FOwner.Repaint;
|
|
end;
|
|
end;
|
|
|
|
function TMycChart.TPanel.Update: Boolean;
|
|
begin
|
|
Result := false;
|
|
for var layer in FLayers do
|
|
begin
|
|
if layer.Update then
|
|
if (Owner.ViewStartIndex <= Owner.FXAxisSeries.TotalCount - layer.TotalCount) then
|
|
Result := true;
|
|
end;
|
|
end;
|
|
|
|
{ TMycChart.TDataLayer }
|
|
|
|
constructor TMycChart.TDataLayer.Create(AParent: TPanel);
|
|
begin
|
|
inherited Create;
|
|
FParent := AParent;
|
|
end;
|
|
|
|
function TMycChart.TDataLayer.GetOwner: TMycChart;
|
|
begin
|
|
Result := FParent.Owner;
|
|
end;
|
|
|
|
{ TMycChart.TAxisLayer }
|
|
|
|
constructor TMycChart.TAxisLayer.Create(AOwner: TMycChart);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
function TMycChart.TAxisLayer.GetOwner: TMycChart;
|
|
begin
|
|
Result := FOwner;
|
|
end;
|
|
|
|
{ TMycChart.TXAxisLayer }
|
|
|
|
procedure TMycChart.TXAxisLayer.Paint(const Canvas: TCanvas; const Viewport: TRectF; const MousePos: TDragPoint);
|
|
var
|
|
caption: string;
|
|
captionRect: TRectF;
|
|
padding: Single;
|
|
candleX: Single;
|
|
textSize: TRectF;
|
|
begin
|
|
// Do not draw if no data or view is invalid
|
|
if GetCount = 0 then
|
|
exit;
|
|
|
|
// 1. Snap X to the candle's center
|
|
candleX := MousePos.BarX;
|
|
|
|
// 2. Draw the vertical line at the snapped position
|
|
Canvas.Stroke.Kind := TBrushKind.Solid;
|
|
Canvas.Stroke.Color := TAlphaColors.Gray;
|
|
Canvas.Stroke.Thickness := 1;
|
|
Canvas.DrawLine(PointF(candleX, Viewport.Top), PointF(candleX, Viewport.Bottom), 1.0);
|
|
|
|
// 3. Get the caption for the index
|
|
caption := GetCaption(FOwner.ViewStartIndex + MousePos.Idx);
|
|
if caption.IsEmpty then
|
|
exit;
|
|
|
|
// 4. Draw the caption with a background
|
|
padding := 1;
|
|
Canvas.Font.Size := 9;
|
|
|
|
// Measure text size
|
|
textSize := TRectF.Create(0, 0, 10000, 10000);
|
|
Canvas.MeasureText(textSize, caption, False, [], TTextAlign.Leading);
|
|
|
|
// Position the caption box, centered on the snapped candle X
|
|
captionRect.Left := candleX - (textSize.Width / 2) - padding;
|
|
captionRect.Width := textSize.Width + (padding * 2);
|
|
captionRect.Top := Viewport.Bottom - textSize.Height - (padding * 2);
|
|
captionRect.Height := textSize.Height + (padding * 2);
|
|
|
|
// Adjust position to not go outside the viewport
|
|
if captionRect.Left < Viewport.Left then
|
|
captionRect.SetLocation(Viewport.Left, captionRect.Top);
|
|
if captionRect.Right > Viewport.Right then
|
|
captionRect.SetLocation(Viewport.Right - captionRect.Width, captionRect.Top);
|
|
|
|
// Draw the styled box
|
|
Canvas.Fill.Color := TAlphaColors.White;
|
|
Canvas.Fill.Kind := TBrushKind.Solid;
|
|
Canvas.Stroke.Kind := TBrushKind.Solid;
|
|
Canvas.Stroke.Color := TAlphaColors.Gray;
|
|
Canvas.Stroke.Thickness := 1;
|
|
Canvas.FillRect(captionRect, 2, 2, AllCorners, 0.7);
|
|
Canvas.DrawRect(captionRect, 2, 2, AllCorners, 1.0);
|
|
|
|
// Draw the text
|
|
Canvas.Fill.Color := TAlphaColors.Black;
|
|
Canvas.FillText(captionRect, caption, false, 1.0, [], TTextAlign.Center, TTextAlign.Center);
|
|
end;
|
|
|
|
end.
|