delphi - 如何同步滚动 2 个不同高度的 TVirtualStringTree 控件？

Question

我有 2 个 TVirtualStringTree (VST) 控件，一个在另一个之上。中间有 TSplitter。滚动第一个时，我使用 VST1/2 的 OnScroll 滚动另一个 VST2/1:

    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;

使用滚动条上下滚动，效果很好。但前提是它们的大小相同。问题是当高度不同时，VST1 滚动到最后而 VST2 仍有很多工作要做，反之亦然，取决于哪个更高/更小。

我尝试了 OffsetY * 高度百分比的多种组合......不同的计算，但即使高度不同，也没有任何滚动同步。

例如，如果 VST1.Height = 100 和 VST.Height = 200，则 VST1 上的每个滚动都应滚动 VST2 2*OffsetY，以匹配它们并同时滚动到底部。好吧，这不是很好。

它们都具有相同的 NodeCount(在附加的示例 20 中，但可能有 1000)。

问题:如何计算一个 VST 中的每个滚动应该滚动另一个同步多少？或者，当高度不同时，是否有比同步两个 VST 滚动更简单的方法

这是.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.

这是.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 拥有 protected 属性(property) RangeY它包含整个滚动范围，是解决方案的关键。

所以，ClientHeight - RangeY = 最大负数 OffsetY在 VST 中。

代码可能如下所示:

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;