Come sincronizzare lo scorrimento di 2 TTrevisualizza?

Question

Ho 2 TTrevisioni. Entrambi hanno lo stesso numero di oggetti. Mi piacerebbe essere in grado di sincronizzare loro barre di scorrimento ... Se mi muovo uno di loro, l'altra si muove anche ...

Per l'orizzontale, funziona come mi aspetto ... per verticale, funziona se uso le frecce della barra di scorrimento, ma non se trascinare il pollice o se uso la rotellina del mouse ...

Ecco un esempio ho scritto per illustrare il mio problema:

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. 

Il 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 

Ho provato anche la creazione di una sottoclasse da TTreeView, ma senza successo (stesso comportamento) ... ho provato con un TMemo, e funziona come previsto ...

Cosa mi sono perso?

Cheers,

W.

Answer 1

In primo luogo, un test interessante: deselezionare "Enable temi runtime" nelle opzioni del progetto e vedrete entrambe le treeviews sarà scorrere in modo sincrono. Questo ci mostra che la procedura di finestra predefinita per un controllo di treeview è implementata in modo diverso nelle diverse versioni di comctl32.dll. Sembrerebbe, l'implementazione in comctl32 v6 è particolarmente diversa quando si scorre in verticale.

Ad ogni modo, sembra che, solo per lo scorrimento verticale, il controllo cerchi la posizione del pollice e quindi aggiusta il contenuto della finestra di conseguenza. Quando instradi un WM_VSCROLL alla vista ad albero adiacente, appare come se fosse il pollice e, non cambiando, decide che non c'è niente da fare (abbiamo solo cambiato la posizione del pollice di quella che stiamo trascinando).

Quindi, per farlo funzionare, regolare la posizione del pollice di treeview prima di inviare lo WM_VSCROLL. La procedura modificata per TV1 sarebbe simile a questa:

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

Aggiornato:

Un'altra risposta che ho ricevuto su un French forum, da ShaiLeTroll:

Questa soluzione funziona perfettamente .. Ho sempre sincronizzato: frecce, pollice, orizzontale, verticale, rotellina del mouse!

Ecco il codice aggiornato (che mescolano entrambe le soluzioni: per pollice & per rotella del mouse):

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.