Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Chart X grid, standard timeframes

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-13 21:49:42 +02:00
parent 840904e42d
commit 4d67d9acbe
8 changed files with 619 additions and 165 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Fmx.Chart.pas
+378 -92
View File
@@ -38,29 +38,66 @@ type
// Abstract base for a drawable layer in a panel.
TLayer = class abstract(TObject)
private
FParent: TPanel;
function GetOwner: TMycChart;
protected
function GetOwner: TMycChart; virtual; abstract;
function GetSeries: TSeries; virtual; abstract;
procedure Update; virtual; abstract;
function GetValueRange(First, Last: Int64; out Min, Max: Double): Boolean; virtual; abstract;
procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>); virtual; abstract;
public
constructor Create(AOwner: TPanel);
procedure Repaint;
property Owner: TMycChart read GetOwner;
property Series: TSeries read GetSeries;
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, YForm: TFunc<Double, Single>); virtual; abstract;
public
constructor Create(AParent: TPanel);
end;
TAxisLayer = class(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;
ViewStartIndex, ViewCount: Int64;
const MousePos: TPointF
); virtual;
public
constructor Create(AOwner: TMycChart);
end;
TXAxisLayer = class(TAxisLayer)
protected
// Paint crosshair and time caption
procedure Paint(
const Canvas: TCanvas;
const Viewport: TRectF;
ViewStartIndex, ViewCount: Int64;
const MousePos: TPointF
); 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;
FSeriesList: TObjectList<TMycChart.TLayer>;
FSeriesList: TObjectList<TMycChart.TDataLayer>;
FWeight: Single;
procedure SetWeight(const Value: Single);
protected
procedure Paint(const Canvas: TCanvas; const Viewport: TRectF; MasterTotalCount: Int64; ViewStartIndex, ViewCount: Int64);
procedure UpdateAndCheckChanges(MasterTotalCount: Int64; ViewStartIndex: Int64; out SeriesChanged, SeriesRepaint: Boolean);
procedure Update(MasterTotalCount: Int64; ViewStartIndex: Int64; out SeriesChanged, SeriesRepaint: Boolean);
public
constructor Create(AOwner: TMycChart);
@@ -70,35 +107,42 @@ type
const DataProvider: IMycDataProvider<TOhlcItem>;
const AUpColor: TAlphaColor = TAlphaColors.Green;
const ADownColor: TAlphaColor = TAlphaColors.Red
): TMycChart.TLayer;
): TMycChart.TDataLayer;
function AddDoubleSeries(
const DataProvider: IMycDataProvider<Double>;
const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
const ALineWidth: Single = 1.5
): TMycChart.TLayer;
): TMycChart.TDataLayer;
property Owner: TMycChart read FOwner;
property Weight: Single read FWeight write SetWeight;
end;
private
FPanelList: TObjectList<TPanel>;
FXAxisSeries: TMycChart.TLayer;
FXAxisSeries: TMycChart.TXAxisLayer;
FLookback: TWriteable<Int64>;
FIdleSubscrId: TMessageSubscriptionId;
FViewStartIndex: Int64;
FViewCount: Int64;
FIsDragging: Boolean;
FDragStartPoint: TPointF;
FMousePos: TPointF;
FIsMouseInControl: Boolean;
FJumpButtonRect: TRectF;
FJumpButtonHot: Boolean;
FJumpButtonPressed: Boolean;
FNeedRepaint: TFlag;
FIsResizing: Boolean;
FResizePanelIndex: Integer;
FHotResizePanelIndex: Integer;
function GetPanel(Index: Integer): TPanel;
function GetPanelCount: Integer;
protected
procedure Paint; override;
procedure DoIdle;
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;
@@ -110,13 +154,15 @@ type
// 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). This series is not drawn.
function SetXAxisSeries<T>(const DataProvider: IMycDataProvider<T>): TMycChart.TLayer;
// Sets the master series that defines the time scale (X-axis).
function SetXAxisSeries(Timeframe: TTimeframe; const DataProvider: IMycDataProvider<TDateTime>): TMycChart.TXAxisLayer;
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;
end;
implementation
@@ -125,6 +171,11 @@ 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);
@@ -136,7 +187,14 @@ begin
FLookback := TWriteable<Int64>.CreateWriteable(1000);
FViewStartIndex := 0;
FViewCount := 100;
FIsDragging := false;
FIsResizing := false;
FResizePanelIndex := -1;
FHotResizePanelIndex := -1;
FIsMouseInControl := false;
FNeedRepaint := TFlag.CreateFlag();
FIdleSubscrId :=
TMessageManager
@@ -144,7 +202,7 @@ begin
.SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin DoIdle; end);
// Create the default panel.
AddPanel;
AddPanel.Weight := 1.0;
end;
destructor TMycChart.Destroy;
@@ -173,16 +231,6 @@ begin
Result := FPanelList.Count;
end;
function TMycChart.SetXAxisSeries<T>(const DataProvider: IMycDataProvider<T>): TMycChart.TLayer;
begin
FXAxisSeries.Free;
// Note: TChartCustomLayer needs its owner to be a TPanel. We use the first panel.
var counter := TChartSeriesCounter<T>.Create;
DataProvider.Link(counter);
FXAxisSeries := TChartCustomLayer<Int64>.Create(Self.Panels[0], counter.Sender);
Result := FXAxisSeries;
end;
procedure TMycChart.DoIdle;
var
prevTotalCount, newTotalCount: Int64;
@@ -202,11 +250,12 @@ begin
for var panel in FPanelList do
begin
var panelChanged, panelRepaint: Boolean;
panel.UpdateAndCheckChanges(prevTotalCount, FViewStartIndex, panelChanged, panelRepaint);
panel.Update(prevTotalCount, FViewStartIndex, panelChanged, panelRepaint);
seriesChanged := seriesChanged or panelChanged;
seriesRepaint := seriesRepaint or panelRepaint;
end;
// When we are not displaying live data, adjust start index accordingly
if (FViewStartIndex > 0) then
begin
countDelta := newTotalCount - prevTotalCount;
@@ -224,6 +273,16 @@ begin
Repaint;
end;
procedure TMycChart.DoMouseLeave;
begin
inherited;
if FIsMouseInControl then
begin
FIsMouseInControl := false;
Repaint;
end;
end;
procedure TMycChart.Paint;
var
rect, panelRect: TRectF;
@@ -231,7 +290,7 @@ var
buttonColor: TAlphaColor;
path: TPathData;
masterTotalCount: Int64;
panelHeight: Single;
panelHeight, totalWeight, currentY: Single;
begin
inherited;
rect := Self.LocalRect;
@@ -244,12 +303,20 @@ begin
end;
masterTotalCount := FXAxisSeries.Series.TotalCount;
panelHeight := rect.Height / PanelCount;
// 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];
panelRect := TRectF.Create(rect.Left, rect.Top + (i * panelHeight), rect.Right, rect.Top + ((i + 1) * panelHeight));
panelHeight := (panel.Weight / totalWeight) * rect.Height;
panelRect := TRectF.Create(rect.Left, currentY, rect.Right, currentY + panelHeight);
// Draw panel content
panel.Paint(Self.Canvas, panelRect, masterTotalCount, FViewStartIndex, FViewCount);
@@ -261,8 +328,14 @@ begin
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 not FIsDragging and not FIsResizing then
FXAxisSeries.Paint(Self.Canvas, rect, FViewStartIndex, FViewCount, FMousePos);
// --- Draw the "jump to latest" button (code unchanged) ---
isButtonVisible := (FViewStartIndex > 0);
@@ -312,7 +385,17 @@ begin
begin
FJumpButtonPressed := true;
Repaint;
exit; // Prevent chart dragging
exit;
end;
// Check for starting a resize
if (Button = TMouseButton.mbLeft) and (FHotResizePanelIndex >= 0) then
begin
FIsResizing := true;
FResizePanelIndex := FHotResizePanelIndex;
FDragStartPoint := TPointF.Create(X, Y);
Capture;
exit;
end;
inherited MouseDown(Button, Shift, X, Y);
@@ -320,61 +403,111 @@ begin
begin
FIsDragging := true;
FDragStartPoint := TPointF.Create(X, Y);
Capture;
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;
// 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
if FIsDragging then
begin
FIsDragging := false;
end;
// 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
isHot: Boolean;
dx: Single;
dx, dy: Single;
indexDelta: Int64;
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 not FIsMouseInControl then
FIsMouseInControl := true;
FMousePos := TPointF.Create(X, Y);
// --- Panel Resizing Logic ---
if FIsResizing then
begin
dy := Y - FDragStartPoint.Y;
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.Y := 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
dx := X - FDragStartPoint.X;
@@ -383,24 +516,16 @@ begin
exit;
end;
// An X-axis series is required for panning
if not Assigned(FXAxisSeries) 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
maxIndex := FXAxisSeries.Series.Count - FViewCount;
if (maxIndex < 0) then
maxIndex := 0;
if (FViewStartIndex < 0) then
FViewStartIndex := 0;
if (FViewStartIndex > maxIndex) then
@@ -408,9 +533,43 @@ begin
FDragStartPoint.X := X;
FDragStartPoint.Y := Y;
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);
@@ -471,22 +630,17 @@ begin
Repaint;
end;
{ TMycChart.TLayer }
constructor TMycChart.TLayer.Create(AOwner: TPanel);
function TMycChart.SetXAxisSeries(Timeframe: TTimeframe; const DataProvider: IMycDataProvider<TDateTime>): TMycChart.TXAxisLayer;
begin
inherited Create;
FParent := AOwner;
end;
FXAxisSeries.Free;
function TMycChart.TLayer.GetOwner: TMycChart;
begin
Result := FParent.Owner;
FXAxisSeries := TChartXAxisTimestampLayer.Create(Self, Timeframe, DataProvider);
Result := FXAxisSeries;
end;
procedure TMycChart.TLayer.Repaint;
begin
FParent.Owner.Repaint;
Owner.Repaint;
end;
{ TMycChart.TPanel }
@@ -495,7 +649,8 @@ constructor TMycChart.TPanel.Create(AOwner: TMycChart);
begin
inherited Create;
FOwner := AOwner;
FSeriesList := TObjectList<TMycChart.TLayer>.Create(true);
FSeriesList := TObjectList<TMycChart.TDataLayer>.Create(true);
FWeight := 0.2;
end;
destructor TMycChart.TPanel.Destroy;
@@ -506,9 +661,9 @@ end;
function TMycChart.TPanel.AddDoubleSeries(
const DataProvider: IMycDataProvider<Double>;
const ALineColor: TAlphaColor;
const ALineWidth: Single
): TMycChart.TLayer;
const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
const ALineWidth: Single = 1.5
): TMycChart.TDataLayer;
begin
Result := TChartLineLayer.Create(Self, DataProvider, ALineColor, ALineWidth);
FSeriesList.Add(Result);
@@ -516,8 +671,9 @@ end;
function TMycChart.TPanel.AddOhlcSeries(
const DataProvider: IMycDataProvider<TOhlcItem>;
const AUpColor, ADownColor: TAlphaColor
): TMycChart.TLayer;
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));
@@ -603,7 +759,20 @@ begin
end;
end;
procedure TMycChart.TPanel.UpdateAndCheckChanges(MasterTotalCount, ViewStartIndex: Int64; out SeriesChanged, SeriesRepaint: Boolean);
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;
procedure TMycChart.TPanel.Update(MasterTotalCount: Int64; ViewStartIndex: Int64; out SeriesChanged, SeriesRepaint: Boolean);
var
seriesCount: Int64;
begin
@@ -623,4 +792,121 @@ begin
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;
procedure TMycChart.TAxisLayer.Paint(
const Canvas: TCanvas;
const Viewport: TRectF;
ViewStartIndex, ViewCount: Int64;
const MousePos: TPointF
);
begin
// Do nothing in base class
end;
{ TMycChart.TXAxisLayer }
procedure TMycChart.TXAxisLayer.Paint(
const Canvas: TCanvas;
const Viewport: TRectF;
ViewStartIndex, ViewCount: Int64;
const MousePos: TPointF
);
var
idx: Int64;
caption: string;
captionRect: TRectF;
padding: Single;
indexFromMouse: Double;
candleX: Single;
textSize: TRectF;
begin
// Do not draw crosshair if mouse is over the jump button
if Owner.JumpButtonRect.Contains(MousePos) then
exit;
// Do not draw if no data or view is invalid
if (not Assigned(Series)) or (Series.Count = 0) or (ViewCount <= 1) then
exit;
// 1. Calculate the data index from the mouse X position
indexFromMouse := ViewStartIndex + (Viewport.Right - MousePos.X) * (ViewCount - 1) / Viewport.Width;
idx := Round(indexFromMouse);
// Check if the calculated index is valid for the series
if (idx < 0) or (idx >= Series.Count) then
exit;
// Snap X to the candle's center
candleX := Viewport.Right - ((idx - ViewStartIndex) * (ViewCount - 1)) / (ViewCount - 1) * (Viewport.Width / (ViewCount - 1));
// 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(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, 1.0);
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.