J'ai deux TTreeviews... je souhaiterais synchroniser leur défilement...

À l'horizontale, cela fonctionne comme je le souhaite...
À la verticale, pas entièrement...

J'ai effectué de nombreux tests (héritage|WindowProc), écumé de nombreux résultats ... en vain... ai-je les bons mot-clés ? (Treeview, scrollbar, synchonize, windowproc, WM_VSCROLL, ...)

Avec un TMemo, cela fonctionne.. mais pas avec des Treeviews...

Concrètement, si on utilise les flèches de la barre de défilement verticale, aucun pb.. mais si on a le malheur de faire glisser la barre coulissante...

Pour illustrer le problème, j'ai crée une nouvelle application fiche VCL dont voici le code :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
unit Unit4;
 
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.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
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
De plus, lorsque l'on fait glisser la barre coulissante, l'événement WindowProc est bien déclenché avec un Msg de type WM_VSCROLL... mais il manque quelque chose que je ne parviens pas à trouver

Si vous avez une idée, n'hésitez pas, merci.

W.