Discussion :

[Whiler]

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.

[ShaiLeTroll]

Est-ce que les noeuds doivent être en phase ?
Tu peux jouer avec un MakeVisible par exemple !

Etonnant que Perform ou SendMessage ne fonctionne pas !!!
Ou alors tu avais un problème de ré-entrance (les WndProc s'appelant en boucle dès la première Sync)

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
procedure TForm1.Tv1WindowProc(var Msg: TMessage);
begin
  originalTv1WindowProc(Msg);
 
  if (ActiveControl <> tv2) and
    ((Msg.Msg = WM_VSCROLL) or (Msg.Msg = WM_HSCROLL) or (Msg.msg = WM_Mousewheel)) then
    tv2.Perform(Msg.Msg, Msg.wparam, Msg.lparam);
end;
 
procedure TForm1.Tv2WindowProc(var Msg: TMessage);
begin
  originalTv2WindowProc(Msg);
 
  if (ActiveControl <> tv1) and
    ((Msg.Msg = WM_VSCROLL) or (Msg.Msg = WM_HSCROLL) or (Msg.msg = WM_Mousewheel)) then
    tv1.Perform(Msg.Msg, Msg.wparam, Msg.lparam);
end;

SetScrollPos et GetScrollPos

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
procedure TForm1.Tv2WindowProc(var Msg: TMessage);
begin
  originalTv2WindowProc(Msg);
  if  Msg.Msg = WM_HSCROLL then
    SetScrollPos(Tv1.Handle, SB_HORZ, GetScrollPos(Tv2.Handle, SB_HORZ), True);  
 
  if Msg.Msg = WM_VSCROLL then
    SetScrollPos(Tv1.Handle, SB_VERT, GetScrollPos(Tv2.Handle, SB_VERT), True);  
end;

Sinon Vcl.Controls.TWinControl.ScrollBy

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
procedure TForm1.Tv2WindowProc(var Msg: TMessage);
begin
  originalTv2WindowProc(Msg);
  if (Msg.Msg = WM_VSCROLL) or (Msg.Msg = WM_HSCROLL) then
    tv1.ScrollBy(?, ?); // joue avec wParam  
end;

The HIWORD of wParam specifies the current position of the scroll box if the LOWORD is SB_THUMBPOSITION or SB_THUMBTRACK; otherwise, this word is not used.

[Whiler]

Merci pour ta réponse.
J'ai eu la solution et je vais en profiter pour répondre à tes pistes que j'avais explorées :

SetScrollPos : Mets à jour l'affichage de la barre de défilement... mais le treeview n'est pas mis à jour en conséquence... il manque un truc...

ScrollBy : scrolle le contenu du Treeview... mais ne mets pas à jour la barre de défilement... par ailleurs l'affichage du contenu est crade (faudrait faire un Fill à blanc avant...) de plus la position scrollée n'est pas mise à jour...

Je ne suis pas dans une boucle sans fin... certains de mes tests l'étaient mais pas celui-ci...

Ce code fonctionne si on désactive les thèmes d'exécution...

Une solution qui fonctionne :

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
procedure TForm1.Tv1WindowProc(var Msg: TMessage);
begin
//  ShowScrollBar(tv1.Handle, SB_HORZ, False);
//  ShowScrollBar(tv1.Handle, SB_VERT, False);
  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
    originalTv2WindowProc(Msg);
  end;
end;

Pour la gestion de la molette de la souris, j'implémente également les événements de la fenêtre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  tv1.Perform(WM_VSCROLL, 1, 0);
  Handled := True;
end;
 
procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  tv1.Perform(WM_VSCROLL, 0, 0);
  Handled := True;
end;

Sinon, pour info, j'utilise MakeVisible uniquement pour le scroll au clavier...

[ShaiLeTroll]

Et le Perform(Msg.Msg..., tu n'as pas préciser son comportement !

[Whiler]

Je n'ai pas réussi à trouver le bon if thenDonc c'était soit :

• Boucle sans fin
• Aucune réaction visible

[ShaiLeTroll]

Oui, une ré-entrance logique puis tour à tour les WndProc s'appelent mutuellement, as-tu testé mon code avec ActiveControl ?

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
procedure TForm1.Tv1WindowProc(var Msg: TMessage);
begin
  originalTv1WindowProc(Msg);
 
  if (ActiveControl <> tv2) and
    ((Msg.Msg = WM_VSCROLL) or (Msg.Msg = WM_HSCROLL) or (Msg.msg = WM_Mousewheel)) then
    tv2.Perform(Msg.Msg, Msg.wparam, Msg.lparam);
end;
 
procedure TForm1.Tv2WindowProc(var Msg: TMessage);
begin
  originalTv2WindowProc(Msg);
 
  if (ActiveControl <> tv1) and
    ((Msg.Msg = WM_VSCROLL) or (Msg.Msg = WM_HSCROLL) or (Msg.msg = WM_Mousewheel)) then
    tv1.Perform(Msg.Msg, Msg.wparam, Msg.lparam);
end;

[Whiler]

Oui... mais ça le fait pas :
Cela fonctionne correctement si tu utilises le control qui a le focus...

mais... les barres de défilement ne donnent pas le focus... du coup...

[Whiler]

Et donc, en adaptant à peine ton code, cela fonctionne :

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
 
private
  sender: TTreeview;
 
...
 
procedure TForm1.Tv1WindowProc(var Msg: TMessage);
begin
  originalTv1WindowProc(Msg);
  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;
 
...

[Whiler]

Après d'autres tests, il s'avèrent que tout ne fonctionne pas.. typiquement, lorsque l'on glisse la barre de défilement...