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.Signals, Myc.Mutable, Myc.Data.Pipeline; 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; const YForm: TFunc ); 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; 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 Producer: TProducer; const AUpColor: TAlphaColor = TAlphaColors.Green; const ADownColor: TAlphaColor = TAlphaColors.Red ): TMycChart.TDataLayer; function AddDoubleSeries( const Producer: TProducer; 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; FXAxisSeries: TMycChart.TXAxisLayer; FLookback: TWriteable; 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 Producer: TProducer): TMycChart.TXAxisLayer; overload; function SetXAxisCounter(const Producer: TProducer): TMycChart.TXAxisLayer; overload; property Lookback: TWriteable 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.Create(true); FXAxisSeries := nil; FLookback := TWriteable.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(const Producer: TProducer): TMycChart.TXAxisLayer; begin FXAxisSeries.Free; FXAxisSeries := TChartXAxisLayer.Create(Self, Producer.Chain(TConverter.CreateCounter)); Result := FXAxisSeries; end; function TMycChart.SetXAxisSeries(Timeframe: TTimeframe; const Producer: TProducer): TMycChart.TXAxisLayer; begin FXAxisSeries.Free; FXAxisSeries := TChartXAxisTimestampLayer.Create(Self, Timeframe, Producer); 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.Create(true); FWeight := AWeight; end; destructor TMycChart.TPanel.Destroy; begin FLayers.Free; inherited Destroy; end; function TMycChart.TPanel.AddDoubleSeries( const Producer: TProducer; const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5 ): TMycChart.TDataLayer; begin Result := TChartLineLayer.Create(Self, Producer, ALineColor, ALineWidth); FLayers.Add(Result); end; function TMycChart.TPanel.AddOhlcSeries( const Producer: TProducer; const AUpColor: TAlphaColor = TAlphaColors.Green; const ADownColor: TAlphaColor = TAlphaColors.Red ): TMycChart.TDataLayer; begin Result := TChartOhlcLayer.Create(Self, Producer, TMutable.Constant(AUpColor), TMutable.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; yTransform: TFunc; 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.