2Treeviewsのスクロールを同期させる方法は？

Question

私は2TTreeviewsを持っています。どちらも同じ数のアイテムを持っています。 私は同期させることができるように彼らのスクロールバーが欲しい...私はそれらのいずれかを移動すると、他の移動をも...

を水平ために、私は期待どおりに動作... 垂直の場合、私はスクロールバーの矢印を使用している場合、それは動作しますが、私は親指をドラッグか、私はマウスホイールを使用している場合...ここ

は私がきたサンプルであれば、それはしていません私の問題を説明するために書かれた：

unit main; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StrUtils; 

type 
    TForm1 = class(TForm) 
    tv1: TTreeView; 
    tv2: TTreeView; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    private 
    { Private declarations } 
    originalTv1WindowProc : TWndMethod; 
    originalTv2WindowProc : TWndMethod; 
    procedure Tv1WindowProc (var Msg : TMessage); 
    procedure Tv2WindowProc (var Msg : TMessage); 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
var 
    i: Integer; 
begin 
    for i := 0 to 10 do 
    begin 
    tv1.Items.AddChild(nil, DupeString('A', 20) + IntToStr(i)); 
    tv2.Items.AddChild(nil, DupeString('B', 20) + IntToStr(i)); 
    end; 

    originalTv1WindowProc := tv1.WindowProc; 
    tv1.WindowProc  := Tv1WindowProc; 
    originalTv2WindowProc := tv2.WindowProc; 
    tv2.WindowProc  := Tv2WindowProc; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    tv1.WindowProc := originalTv1WindowProc; 
    tv2.WindowProc := originalTv2WindowProc; 

    originalTv1WindowProc := nil; 
    originalTv2WindowProc := nil; 
end; 

procedure TForm1.Tv1WindowProc(var Msg: TMessage); 
begin 
    originalTv1WindowProc(Msg); 
    if ((Msg.Msg = WM_VSCROLL) 
    or (Msg.Msg = WM_HSCROLL) 
    or (Msg.msg = WM_Mousewheel)) then 
    begin 
// tv2.Perform(Msg.Msg, Msg.wparam, Msg.lparam); 
    originalTv2WindowProc(Msg); 
    end; 
end; 

procedure TForm1.Tv2WindowProc(var Msg: TMessage); 
begin 
    originalTv2WindowProc(Msg); 
    if ((Msg.Msg = WM_VSCROLL) 
    or (Msg.Msg = WM_HSCROLL) 
    or (Msg.msg = WM_Mousewheel)) then 
    begin 
// tv1.Perform(Msg.Msg, Msg.wparam, Msg.lparam); 
    originalTv1WindowProc(Msg); 
    end; 
end; 

end. 

DFM：

object Form1: TForm1 
    Left = 0 
    Top = 0 
    Caption = 'Form1' 
    ClientHeight = 113 
    ClientWidth = 274 
    Color = clBtnFace 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    OnCreate = FormCreate 
    OnDestroy = FormDestroy 
    PixelsPerInch = 96 
    TextHeight = 13 
    object tv1: TTreeView 
    Left = 8 
    Top = 8 
    Width = 121 
    Height = 97 
    Indent = 19 
    TabOrder = 0 
    end 
    object tv2: TTreeView 
    Left = 144 
    Top = 8 
    Width = 121 
    Height = 97 
    Indent = 19 
    TabOrder = 1 
    end 
end 

私もTTreeViewのからサブクラスを作成しようとしたが、成功（同じ動作）することなく、... は、私はTMemoオブジェクトを試みたが、期待どおりに動作しますが...

私は何を欠席しましたか？

乾杯、

W.

Answer 1

まず、興味深いテストは：オフプロジェクトのオプションに「ランタイムテーマを有効にする」と、あなたは、ツリービューの両方が同期スクロールします表示されます。これは、ツリービューコントロールのデフォルトのウィンドウプロシージャが、異なるバージョンのcomctl32.dllで異なって実装されていることを示しています。 comctl32 v6の実装は、垂直スクロール時に特に異なるようです。

とにかく、垂直スクロールの場合のみ、コントロールはサム位置を探して、それに応じてウィンドウの内容を調整するように見えます。 WM_VSCROLLを隣接するツリービューにルーティングすると、親指の位置が表示され、変更されていないので、何もしないと判断します（ドラッグしている親指の位置を変更しただけです）。

したがって、動作させるには、WM_VSCROLLを送信する前にツリービューのサム位置を調整します。 TV1のための修正手順は、次のようになります。

procedure TForm1.Tv1WindowProc(var Msg: TMessage); 
begin 
    originalTv1WindowProc(Msg); 

    if Msg.Msg = WM_VSCROLL then begin 
    if Msg.WParamLo = SB_THUMBTRACK then 
     SetScrollPos(tv2.Handle, SB_VERT, Msg.WParamHi, False); 
    end; 

    if ((Msg.Msg = WM_VSCROLL) 
    or (Msg.Msg = WM_HSCROLL) 
    or (Msg.msg = WM_Mousewheel)) then 
    begin 
// tv2.Perform(Msg.Msg, Msg.wparam, Msg.lparam); 
    originalTv2WindowProc(Msg); 
    end; 
end; 

Answer 2

更新：私はFrench forumに乗った

別の答え、ShaiLeTrollから：

このソリューションは完璧に動作を..私は常に同期されます：矢印、親指、水平、垂直、マウスホイール！ここで

更新されたコード（両方の溶液を混合：マウスホイールのための親指&用）：ある

unit main; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StrUtils; 

type 
    TForm1 = class(TForm) 
    tv1: TTreeView; 
    tv2: TTreeView; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    private 
    { Private declarations } 
    originalTv1WindowProc : TWndMethod; 
    originalTv2WindowProc : TWndMethod; 

    sender: TTreeView; 

    procedure Tv1WindowProc (var Msg : TMessage); 
    procedure Tv2WindowProc (var Msg : TMessage); 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
var 
    i: Integer; 
    tn: TTreeNode; 
begin 
    for i := 0 to 20 do 
    begin 
    tn := tv1.Items.AddChild(nil, DupeString('A', 20) + IntToStr(i)); 
    tv1.Items.AddChild(tn, DupeString('C', 20) + IntToStr(i)); 
    tv1.Items.AddChild(tn, DupeString('C', 20) + IntToStr(i)); 
    tn := tv2.Items.AddChild(nil, DupeString('B', 20) + IntToStr(i)); 
    tv2.Items.AddChild(tn, DupeString('D', 20) + IntToStr(i)); 
    tv2.Items.AddChild(tn, DupeString('D', 20) + IntToStr(i)); 
    end; 

    originalTv1WindowProc := tv1.WindowProc; 
    tv1.WindowProc  := Tv1WindowProc; 
    originalTv2WindowProc := tv2.WindowProc; 
    tv2.WindowProc  := Tv2WindowProc; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    tv1.WindowProc  := originalTv1WindowProc; 
    tv2.WindowProc  := originalTv2WindowProc; 
    originalTv1WindowProc := nil; 
    originalTv2WindowProc := nil; 
end; 

procedure TForm1.Tv1WindowProc(var Msg: TMessage); 
begin 
    originalTv1WindowProc(Msg); 

    if Msg.Msg = WM_VSCROLL then 
    begin 
    if Msg.WParamLo = SB_THUMBTRACK then 
    begin 
     SetScrollPos(tv2.Handle, SB_VERT, Msg.WParamHi, False); 
    end; 
    end; 

    if (sender <> tv2) and 
    ((Msg.Msg = WM_VSCROLL) or (Msg.Msg = WM_HSCROLL) or (Msg.Msg = WM_MOUSEWHEEL)) then 
    begin 
    sender := tv1; 
    tv2.Perform(Msg.Msg, Msg.wparam, Msg.lparam); 
    sender := nil; 
    end; 
end; 

procedure TForm1.Tv2WindowProc(var Msg: TMessage); 
begin 
    originalTv2WindowProc(Msg); 

    if Msg.Msg = WM_VSCROLL then 
    begin 
    if Msg.WParamLo = SB_THUMBTRACK then 
    begin 
     SetScrollPos(tv1.Handle, SB_VERT, Msg.WParamHi, False); 
    end; 
    end; 

    if (sender <> tv1) and ((Msg.Msg = WM_VSCROLL) or (Msg.Msg = WM_HSCROLL) or (Msg.Msg = WM_MOUSEWHEEL)) then 
    begin 
    sender := tv2; 
    tv1.Perform(Msg.Msg, Msg.wparam, Msg.lparam); 
    sender := nil; 
    end; 
end; 

end.