6

2つのTTreeviewがあります。どちらも同じ数のアイテムがあります。スクロールバーを同期できるようにしたいのですが...一方を動かすと、もう一方も動きます...

水平の場合は期待どおりに機能します...垂直の場合は、スクロールバーの矢印を使用すると機能しますが、親指をドラッグしたり、マウスホイールを使用したりすると機能しません...

これが私の問題を説明するために書いたサンプルです：

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

ここに画像の説明を入力してください

TTreeviewからサブクラスを作成しようとしましたが、成功しませんでした（同じ動作）... TMemoで試しましたが、期待どおりに機能します...

私は何を取りこぼしたか？

乾杯、

W。

4

2 に答える 2

10

まず、興味深いテストです。プロジェクトオプションの[ランタイムテーマを有効にする]のチェックを外すと、両方のツリービューが同期してスクロールすることがわかります。これは、ツリービューコントロールのデフォルトのウィンドウプロシージャが、comctl32.dllのバージョンによって実装が異なることを示しています。comctl32 v6での実装は、垂直方向にスクロールする場合は特に異なります。

とにかく、垂直スクロールの場合のみ、コントロールは親指の位置を探し、それに応じてウィンドウの内容を調整するようです。を隣接するツリービューにルーティングするWM_VSCROLLと、親指の位置が表示され、変更されていないため、何もする必要はないと判断されます（ドラッグしているツリービューの親指の位置のみを変更しました）。

したがって、それを機能させるには、を送信する前にツリービューのサムの位置を調整しWM_VSCROLLます。tv1の変更された手順は次のようになります。

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;
于 2012-05-09T23:57:29.393 に答える
2

更新しました：

ShaiLeTrollからのフランスのフォーラムで得た別の答え：

このソリューションは完全に機能します。私は常に同期しています：矢印、親指、水平、垂直、マウスホイール！

更新されたコードは次のとおりです（親指用とマウスホイール用の両方のソリューションを組み合わせています）：

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.
于 2012-05-10T15:20:47.310 に答える