How to synchronize scrolling of 2 TVirtualStringTree controls with different heights?

Question

I have 2 TVirtualStringTree (VST) controls, one on top of the other. With TSplitter in between. I use OnScroll of VST1/2 to scroll the other VST2/1 when scrolling the first one:

    procedure TForm1.VST1Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
    begin
      VST2.OffsetY:=VST1.OffsetY;
    end;

    procedure TForm1.VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
    begin
      VST1.OffsetY:=VST2.OffsetY;
    end;

Using scrollbars to scroll up and down, works great. But only if they are both the same size. The problem is when heights are different, either VST1 scrolls to the end and VST2 still has plenty to go, or vice versa, depends which is higher/smaller.

I tried numerous combination of OffsetY * percentage of height... different calculation but nothing that would scroll synchronized even when heights are different.

For example if VST1.Height = 100 and VST.Height = 200, then each scroll on VST1 should scroll VST2 2*OffsetY, to match them and scroll to the bottom at the same time. Well, this is not working good.

They both have the same NodeCount (in attached example 20, but could have 1000s).

Question: how to calculate how much each scroll in one VST should scroll the other to synchronize? OR is there another simpler way than synchronize scroll of both VSTs, when different heights

Here is .pas

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, VirtualTrees;

type
  TForm1 = class(TForm)
    VST1: TVirtualStringTree;
    VST2: TVirtualStringTree;
    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure VST1Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
    procedure VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  VST1.RootNodeCount := 20;
  VST2.RootNodeCount := 20;
end;

procedure TForm1.VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
  CellText:=IntToStr(Node.Index+1);
end;

procedure TForm1.VST1Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
begin
  VST2.OffsetY:=VST1.OffsetY;
end;

procedure TForm1.VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
  CellText:=IntToStr(Node.Index+1);
end;

procedure TForm1.VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
begin
  VST1.OffsetY:=VST2.OffsetY;
end;

end.

and here is .dfm:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 337
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 0
    Top = 100
    Width = 635
    Height = 3
    Cursor = crVSplit
    Align = alTop
    ExplicitWidth = 237
  end
  object VST1: TVirtualStringTree
    Left = 0
    Top = 0
    Width = 635
    Height = 100
    Align = alTop
    Header.AutoSizeIndex = 0
    Header.Font.Charset = DEFAULT_CHARSET
    Header.Font.Color = clWindowText
    Header.Font.Height = -11
    Header.Font.Name = 'Tahoma'
    Header.Font.Style = []
    Header.MainColumn = -1
    TabOrder = 0
    OnGetText = VST1GetText
    OnScroll = VST1Scroll
    Columns = <>
  end
  object VST2: TVirtualStringTree
    Left = 0
    Top = 103
    Width = 635
    Height = 234
    Align = alClient
    Header.AutoSizeIndex = 0
    Header.Font.Charset = DEFAULT_CHARSET
    Header.Font.Color = clWindowText
    Header.Font.Height = -11
    Header.Font.Name = 'Tahoma'
    Header.Font.Style = []
    Header.MainColumn = -1
    TabOrder = 1
    OnGetText = VST2GetText
    OnScroll = VST2Scroll
    Columns = <>
  end
end

Answer 1

VST has a protected property RangeY which contains the entire scrolling range and is the key to the solution.

So, ClientHeight - RangeY = the maximum negative OffsetY in the VST.

The code might look as follow:

type
  TForm1 = class(TForm)   
  ...
  private
    FScrolling: boolean;
    procedure SyncScroll(Sender, Target: TBaseVirtualTree);
  end;

...

type
  TCustomVirtualStringTreeAccess = class(TCustomVirtualStringTree);

procedure TForm1.SyncScroll(Sender, Target: TBaseVirtualTree);
var
  SenderMaxOffsetY, TargetMaxOffsetY: Integer;
  DY: Extended;
begin
  if FScrolling then Exit; // Avoid reentrancy from Target
  SenderMaxOffsetY := Sender.ClientHeight - Integer(TCustomVirtualStringTreeAccess(Sender).RangeY);
  TargetMaxOffsetY := Target.ClientHeight - Integer(TCustomVirtualStringTreeAccess(Target).RangeY);
  if SenderMaxOffsetY = 0 then Exit;
  DY := Sender.OffsetY / SenderMaxOffsetY;
  FScrolling := True;
  try
    Target.OffsetY := Round(TargetMaxOffsetY * DY);
  finally
    FScrolling := False;
  end;
end;

procedure TForm1.VST1Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
begin
  SyncScroll(Sender, VST2);
end;

procedure TForm1.VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
begin
  SyncScroll(Sender, VST1);
end;