Synchronize two cursors (Line and Gantt)

[nizarazu]

Hello,

I'm trying to synchronize two cursors on differents type of series, the first one is a TLineSeries and the second is a Gantt.

Above the code I'm using :

Code: Select all

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 775
  ClientWidth = 1071
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  OnShow = FormShow
  TextHeight = 15
  object Chart1: TChart
    Left = 0
    Top = 0
    Width = 1071
    Height = 369
    BackWall.Brush.Gradient.Direction = gdBottomTop
    BackWall.Brush.Gradient.EndColor = clWhite
    BackWall.Brush.Gradient.StartColor = 15395562
    BackWall.Brush.Gradient.Visible = True
    BackWall.Transparent = False
    Foot.Font.Color = clBlue
    Foot.Font.Name = 'Verdana'
    Gradient.Direction = gdBottomTop
    Gradient.EndColor = clWhite
    Gradient.MidColor = 15395562
    Gradient.StartColor = 15395562
    Gradient.Visible = True
    LeftWall.Color = 14745599
    Legend.Font.Name = 'Verdana'
    Legend.Shadow.Transparency = 0
    Legend.Visible = False
    MarginBottom = 5
    MarginLeft = 30
    MarginRight = 30
    MarginTop = 30
    MarginUnits = muPixels
    RightWall.Color = 14745599
    Title.Font.Name = 'Verdana'
    Title.Text.Strings = (
      'TChart')
    BottomAxis.Axis.Color = 4210752
    BottomAxis.Grid.Color = 11119017
    BottomAxis.LabelsFormat.Font.Name = 'Verdana'
    BottomAxis.TicksInner.Color = 11119017
    BottomAxis.Title.Font.Name = 'Verdana'
    DepthAxis.Axis.Color = 4210752
    DepthAxis.Grid.Color = 11119017
    DepthAxis.LabelsFormat.Font.Name = 'Verdana'
    DepthAxis.TicksInner.Color = 11119017
    DepthAxis.Title.Font.Name = 'Verdana'
    DepthTopAxis.Axis.Color = 4210752
    DepthTopAxis.Grid.Color = 11119017
    DepthTopAxis.LabelsFormat.Font.Name = 'Verdana'
    DepthTopAxis.TicksInner.Color = 11119017
    DepthTopAxis.Title.Font.Name = 'Verdana'
    LeftAxis.Axis.Color = 4210752
    LeftAxis.Grid.Color = 11119017
    LeftAxis.LabelsFormat.Font.Name = 'Verdana'
    LeftAxis.TicksInner.Color = 11119017
    LeftAxis.Title.Font.Name = 'Verdana'
    RightAxis.Axis.Color = 4210752
    RightAxis.Grid.Color = 11119017
    RightAxis.LabelsFormat.Font.Name = 'Verdana'
    RightAxis.TicksInner.Color = 11119017
    RightAxis.Title.Font.Name = 'Verdana'
    TopAxis.Axis.Color = 4210752
    TopAxis.Grid.Color = 11119017
    TopAxis.LabelsFormat.Font.Name = 'Verdana'
    TopAxis.TicksInner.Color = 11119017
    TopAxis.Title.Font.Name = 'Verdana'
    View3D = False
    View3DWalls = False
    Align = alTop
    TabOrder = 0
    ExplicitWidth = 1067
    DefaultCanvas = 'TGDIPlusCanvas'
    ColorPaletteIndex = 13
    object Series1: TLineSeries
      HoverElement = [heCurrent]
      Brush.BackColor = clDefault
      Pointer.InflateMargins = True
      Pointer.Style = psRectangle
      XValues.Name = 'X'
      XValues.Order = loAscending
      YValues.Name = 'Y'
      YValues.Order = loNone
      Data = {
        00190000000000000000E07A400000000000E080400000000000787E40000000
        0000107D400000000000B87F400000000000E87C400000000000688040000000
        0000687A4000000000008873400000000000307B400000000000487740000000
        0000E07A400000000000E0804000000000008081400000000000048540000000
        00005881400000000000187F4000000000006880400000000000848240000000
        0000288440000000000050844000000000000886400000000000B48440000000
        00000C82400000000000788440}
      Detail = {0000000000}
    end
    object ChartTool1: TCursorTool
      FollowMouse = True
      Pen.Width = 2
      XValue = 12.000000000000000000
      YValue = 509.410774410774400000
      OnChange = ChartTool1Change
      object TAnnotationTool
        Shape.Alignment = taCenter
        Shape.CustomPosition = True
        Shape.Left = 495
        Shape.Shadow.Visible = False
        Shape.Text = '12'
        Shape.TextAlignment = taCenter
        Shape.Top = 334
        Shape.Visible = False
        TextAlignment = taCenter
      end
    end
  end
  object Chart2: TChart
    Left = 0
    Top = 369
    Width = 1071
    Height = 406
    BackWall.Brush.Gradient.Direction = gdBottomTop
    BackWall.Brush.Gradient.EndColor = clWhite
    BackWall.Brush.Gradient.StartColor = 15395562
    BackWall.Brush.Gradient.Visible = True
    BackWall.Transparent = False
    Foot.Font.Color = clBlue
    Foot.Font.Name = 'Verdana'
    Gradient.Direction = gdBottomTop
    Gradient.EndColor = clWhite
    Gradient.MidColor = 15395562
    Gradient.StartColor = 15395562
    Gradient.Visible = True
    LeftWall.Color = 14745599
    Legend.Font.Name = 'Verdana'
    Legend.Shadow.Transparency = 0
    Legend.Visible = False
    MarginLeft = 10
    MarginRight = 10
    MarginUnits = muPixels
    RightWall.Color = 14745599
    Title.Font.Name = 'Verdana'
    Title.Text.Strings = (
      'TChart')
    BottomAxis.Axis.Color = 4210752
    BottomAxis.Grid.Color = 11119017
    BottomAxis.LabelsFormat.Font.Name = 'Verdana'
    BottomAxis.TicksInner.Color = 11119017
    BottomAxis.Title.Font.Name = 'Verdana'
    BottomAxis.Visible = False
    DepthAxis.Axis.Color = 4210752
    DepthAxis.Grid.Color = 11119017
    DepthAxis.LabelsFormat.Font.Name = 'Verdana'
    DepthAxis.TicksInner.Color = 11119017
    DepthAxis.Title.Font.Name = 'Verdana'
    DepthTopAxis.Axis.Color = 4210752
    DepthTopAxis.Grid.Color = 11119017
    DepthTopAxis.LabelsFormat.Font.Name = 'Verdana'
    DepthTopAxis.TicksInner.Color = 11119017
    DepthTopAxis.Title.Font.Name = 'Verdana'
    LeftAxis.Axis.Color = 4210752
    LeftAxis.Grid.Color = 11119017
    LeftAxis.LabelsAlign = alOpposite
    LeftAxis.LabelsFormat.Font.Name = 'Verdana'
    LeftAxis.LabelsFormat.Margins.Left = 1
    LeftAxis.TicksInner.Color = 11119017
    LeftAxis.Title.Font.Name = 'Verdana'
    RightAxis.Axis.Color = 4210752
    RightAxis.Grid.Color = 11119017
    RightAxis.LabelsFormat.Font.Name = 'Verdana'
    RightAxis.TicksInner.Color = 11119017
    RightAxis.Title.Font.Name = 'Verdana'
    TopAxis.Axis.Color = 4210752
    TopAxis.Grid.Color = 11119017
    TopAxis.LabelsFormat.Font.Name = 'Verdana'
    TopAxis.TicksInner.Color = 11119017
    TopAxis.Title.Font.Name = 'Verdana'
    View3D = False
    View3DWalls = False
    Align = alClient
    TabOrder = 1
    ExplicitWidth = 1067
    ExplicitHeight = 405
    DefaultCanvas = 'TGDIPlusCanvas'
    ColorPaletteIndex = 13
    object Series2: TGanttSeries
      HoverElement = [heCurrent]
      ClickableLine = False
      Pointer.InflateMargins = True
      Pointer.Style = psRectangle
      Pointer.VertSize = 10
      XValues.Name = 'D'#233'but'
      XValues.Order = loAscending
      YValues.Name = 'Y'
      YValues.Order = loNone
      Callout.Style = psRightTriangle
      Callout.Arrow.Visible = False
      StartValues.Name = 'D'#233'but'
      StartValues.Order = loAscending
      EndValues.Name = 'Fin'
      EndValues.Order = loNone
      NextTask.Name = 'Nouvelle t'#226'che'
      NextTask.Order = loNone
      Data = {
        040A00000000000000A015E640FF0600000044657369676E00000000C016E640
        000000000000F0BF00000000C015E640FF0B00000050726F746F747970616765
        000000004018E640000000000000F0BF000000002016E640FF0D00000044E976
        656C6F7070656D656E74000000002018E640000000000000F0BF000000008016
        E640FF0600000056656E746573000000002019E640000000000000F0BF000000
        00C016E640FF090000004D61726B6574696E6700000000E018E6400000000000
        00F0BF000000006017E640FF040000005465737400000000A019E64000000000
        0000F0BF00000000C017E640FF080000004D616E756661632E000000002019E6
        40000000000000F0BF000000000018E640FF09000000446562756767696E6700
        0000002019E640000000000000F0BF000000008018E640FF100000004E6F7576
        656C6C652056657273696F6E00000000201BE640000000000000F0BF00000000
        A01BE640FF080000004D616E756661632E00000000801EE640000000000000F0
        BF}
      Detail = {0000000000}
    end
    object ChartTool2: TCursorTool
      FollowMouse = True
      FullRepaint = True
      Pen.Width = 2
      Series = Series2
      XValue = 12.000000000000000000
      YValue = 150.000000000000000000
      object TAnnotationTool
        Shape.Alignment = taCenter
        Shape.Shadow.Visible = False
        Shape.TextAlignment = taCenter
        Shape.Visible = False
        TextAlignment = taCenter
      end
    end
  end
end

Code: Select all

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VclTee.TeeGDIPlus, VCLTee.TeEngine, Vcl.ExtCtrls, VCLTee.TeeProcs, VCLTee.Chart,
  VCLTee.Series, VCLTee.TeeTools, VCLTee.GanttCh, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Chart1: TChart;
    Chart2: TChart;
    Series1: TLineSeries;
    ChartTool1: TCursorTool;
    ChartTool2: TCursorTool;
    Series2: TGanttSeries;
    procedure ChartTool1Change(Sender: TCursorTool; x, y: Integer; const XValue, YValue: Double; Series: TChartSeries;
      ValueIndex: Integer);

    procedure FormShow(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


// This procedure synchronizes two cursors.
// "Source" is the original cursor, and "Dest" the cursor
// that is re-positioned.

Procedure CursorSynchronize( Source, Dest: TCursorTool );
begin
  Dest.ParentChart.AutoRepaint:=False; // stop repainting
  Dest.RedrawCursor;   // hide cursor

  Dest.YValue := Source.YValue;
  Dest.XValue := Source.XValue;

  Dest.RedrawCursor;  // draw cursor again
  Dest.ParentChart.AutoRepaint:=True; // enable repainting
end;

Procedure LeftAlignCharts(Const Charts: Array of TCustomChart; aLeft: Integer; aWidth: Integer);

Var i,
    LabelSize : Integer;

Begin
  For i := Low(Charts) to High(Charts) do
  With Charts[i] do
  Begin
    Left := aLeft;
    MarginLeft := 10;
    Width := aWidth;
    LeftAxis.LabelsSize := 100;
  End;
End;

procedure TForm1.ChartTool1Change(Sender: TCursorTool; x,
  y: Integer; const XValue, YValue: Double; Series: TChartSeries;
  ValueIndex: Integer);
begin
  CursorSynchronize( Sender, ChartTool2 );
end;


procedure TForm1.FormShow(Sender: TObject);
begin
  LeftAlignCharts([Chart1,Chart2],200,Form1.Width);
end;

end.

This code doesn't work and I don't know why.

Any help please ?

[nizarazu]

Ok, my issue was that I need to have at least the same bottom Axis to be able to make it works...

The issue now is that I'm getting this when I'm moving from the first chart (LineSeries) :

Capture d'écran 2023-10-27 104118.png (59.2 KiB) Viewed 4995 times

[Yeray]

Hello,

Try forcing a chart repaint after changing the cursor position. Ie, at the end of the CursorSynchronize method:

Code: Select all

  Dest.ParentChart.Draw;

[nizarazu]

As I want to synchronize in both way, I did this :

Code: Select all

// This procedure synchronizes two cursors.
// "Source" is the original cursor, and "Dest" the cursor
// that is re-positioned.

Procedure CursorSynchronize( Source, Dest: TCursorTool );
begin
  Dest.ParentChart.AutoRepaint:=False; // stop repainting
  Dest.RedrawCursor;   // hide cursor

  //Dest.YValue := Source.YValue;
  Dest.XValue := Source.XValue;

  Dest.RedrawCursor;  // draw cursor again
  Dest.ParentChart.AutoRepaint:=True; // enable repainting
  Dest.ParentChart.Draw;
end;

procedure TForm1.ChartTool1Change(Sender: TCursorTool; x,
  y: Integer; const XValue, YValue: Double; Series: TChartSeries;
  ValueIndex: Integer);

var
  MyPoint : TPoint;

begin
  MyPoint := Chart1.ScreenToClient(Mouse.CursorPos);
  if PtInRect(Chart1.ClientRect, MyPoint) then
  begin
    ChartTool1.Style := TCursorToolStyle.cssBoth;
    CursorSynchronize( Sender, ChartTool2 );
  end;
end;


procedure TForm1.ChartTool2Change(Sender: TCursorTool; x, y: Integer; const XValue, YValue: Double;
  Series: TChartSeries; ValueIndex: Integer);

var
  MyPoint : TPoint;

begin
  MyPoint := Chart2.ScreenToClient(Mouse.CursorPos);
  if PtInRect(Chart2.ClientRect, MyPoint) then
  begin
    ChartTool1.Style := TCursorToolStyle.cssVertical;
    CursorSynchronize( Sender, ChartTool1 );
  end;
end;

My issue now is that it's laggy when I have some datas. For exemple with the code above

Code: Select all

procedure TForm1.FormShow(Sender: TObject);

var tmpDate: TDateTime;

    i: Integer;

begin
  Chart1.BottomAxis.Automatic := TRUE;
  Series1.XValues.DateTime := TRUE;

  tmpDate:=Now;
  for i:=0 to 1440 do
  begin
    Series1.AddXY(tmpDate, random*100);
    Series6.AddXY(tmpDate, random*100);
    Series3.AddXY(tmpDate, random*100);
    Series4.AddXY(tmpDate, random*100);
    Series5.AddXY(tmpDate, random*100);
    tmpDate:=IncMinute(tmpDate);
  end;

  Series2.Clear;
  tmpDate:=Now;
  for i:=0 to 23 do
  begin
    Series2.AddGanttColor(tmpDate, IncHour(tmpDate), i, '',clRed);
    tmpDate:=IncHour(tmpDate);
  end;

  LeftAlignCharts([Chart1,Chart2],500,Form1.Width);
end;

It's laggy only when we try to synchronize from the Gantt chart.

Any help to optimize this ?

Thank you in advance

[Yeray]

Hello,

Forcing a chart repaint to avoid the cursor being drawn multiple times on top of the chart gives, since you have thousands of points in the top chart, it ends in a slow interactivity.
I've seen you have set the FullRepaint property to True for the TCursorTool at the bottom, which causes the problem in first place. Changing it to False solves the issue for me here without having to force a chart repaint.
Here the full test project:

SyncTwoCursors.zip

(3.38 KiB) Downloaded 273 times