How to sync scroll 2 TTreeviews?

Question

I have 2 TTreeviews . Both of them have the same number of elements. I would like to synchronize their scrollbars ... If I translate one of them, the other moves as well ...

For horizontal, it works as I expect ... For vertical, it works if I use the scroll bar arrows, but it doesn’t, if I drag my thumb or if I use the mouse wheel ...

Here is an example that I wrote to illustrate my problem:

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 

I also tried to subclass from TTreeview, but without success (same behavior) ... I tried with TMemo and it works as expected ...

What did I miss?

Greetings

Sh.

Answer 1

Firstly, an interesting test: uncheck the "enable runtime themes" checkbox in the project settings and you will see that both trees will scroll synchronously. This shows us that the standard window procedure for the TreeView control is implemented differently in different versions of comctl32.dll. It would seem that the implementation in comctl32 v6 is especially different when scrolling vertically.

In any case, it seems that only for vertical scrolling the control searches for the position of the thumb, and then adjusts the contents of the window accordingly. When you direct WM_VSCROLL to an adjacent tree view, it looks like its thumb position and, since it does not change, decides what to do with nothing (we just changed the thumb position of the one we are dragging).

So, to make it work, adjust the position of the thumb of the tree before sending WM_VSCROLL . The modified procedure for tv1 will look like this:

 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

Updated:

Another answer I received on the French forum from ShaiLeTroll :

This solution works fine .. I always synchronized: arrows, thumb, horizontal, vertical, mouse wheel!

Here is the updated code ( which mixes both solutions: for thumb and for mouse wheel ):

 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.