Jak zsynchronizować przewijanie 2 widoków TTreeviews?

Question

Mam 2 TTreeviews. Oba mają taką samą liczbę przedmiotów. Chciałbym móc synchronizować ich przewijania ... Gdybym przenieść jeden z nich, inne ruchy również ...

dla poziomego, to działa jak oczekuję ... do pionu, to działa, jeśli mogę użyć strzałek na pasku przewijania, ale nie jeśli przeciągnij kciuk lub jeśli mogę użyć kółka myszy...

Oto przykład mam napisane w celu zilustrowania mojego problemu:

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 

Próbowałem też utworzenie podklasy z TTreeview, ale bez powodzenia (samo zachowanie) ... Próbowałem z TMemo i działa zgodnie z oczekiwaniami ...

Czego mi brakowało?

Cheers,

W.

Answer 1

pierwsze, ciekawe testy: odznacz „Włącz uruchomieniowe tematy” w opcjach projektu, a zobaczysz oba treeviews przewinie synchronicznie. To pokazuje nam, że domyślna procedura okna dla kontroli widoku drzewa jest zaimplementowana inaczej w różnych wersjach comctl32.dll. Wydaje się, że implementacja w comctl32 v6 jest szczególnie odmienna podczas przewijania w pionie.

W każdym razie wydaje się, że w przypadku przewijania w pionie kontrola wyszukuje pozycję kciuka, a następnie odpowiednio dostosowuje zawartość okna. Kiedy przekierowujesz WM_VSCROLL do sąsiedniego drzewa, wygląda on na pozycję kciuka, a ponieważ nie jest zmieniony, decyduje, że nie ma nic do zrobienia (zmienialiśmy tylko położenie kciuka tego, który przeciągamy).

Aby więc zadziałać, dostosuj pozycję kciuka drzewa przed wysłaniem WM_VSCROLL. Procedura zmodyfikowane do TV1 będzie wyglądać następująco:

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

Aktualizacja:

Inna odpowiedź mam na French forum z ShaiLeTroll:

To rozwiązanie działa idealnie .. I zawsze zsynchronizowane: strzałki, kciuk, poziome, pionowe, kółko myszy!

Oto zaktualizowany kod (które wymieszać oba rozwiązania: dla kciuka & za kółkiem myszy):

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.