同期スクロールコンポーネントDelphi

Question

私はVCLフォームアプリケーションで2つのTDBGridコンポーネントのスクロールを同期しようとしています。スクロールイベントの下にWM_VSCROLLメッセージを送信しようとしましたが、これは誤った操作をもたらします。スクロールバーをクリックするだけでなく、セルを強調表示するだけでなく、マウスボタンを上下にします。全体的なアイデアは、一種の一致ダイアログを表示する互いの隣に2つのグリッドを持つことです。

試してみた

SendMessage( gridX.Handle, WM_VSCROLL, SB_LINEDOWN, 0 );

.

も

procedure TForm1.GridXCustomWndProc( var Msg: TMessage );
begin
Msg.Result := CallWindowProc( POldWndProc, gridX.Handle, Msg.Msg, Msg.wParam, Msg.lParam );

   if ( Msg.Msg = WM_VSCROLL ) then 
   begin
      gridY.SetActiveRow( gridX.GetActiveRow );
      gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam );
      SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True );
   end;
end;

.

と

procedure TForm1.GridxCustomWndProc( var Msg: TMessage );
begin
   if ( Msg.Msg = WM_VSCROLL ) then 
   begin
      gridY.SetActiveRow( gridX.GetActiveRow );
      gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam );
      SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True );
   end;
   inherited WndProc( Msg );
end;

.

最初のものは一時的な解決策のみであり、2番目の結果は無効なメモリ読み込みを実行し、3番目の結果はスタックオーバーフローをもたらします。だからこれらの解決策のどれも私のために働いていないようです。私はこの仕事を達成する方法についていくつかの入力が大好きです！事前にありがとうございます。

更新：溶液

  private
    [...]
    GridXWndProc, GridXSaveWndProc: Pointer;
    GridYWndProc, GridYSaveWndProc: Pointer;
    procedure GridXCustomWndProc( var Msg: TMessage );
    procedure GridYCustomWndProc( var Msg: TMessage );

procedure TForm1.FormCreate(Sender: TObject);
begin
  GridXWndProc := classes.MakeObjectInstance( GridXCustomWndProc );
  GridXSaveWndProc := Pointer( GetWindowLong( GridX.Handle, GWL_WNDPROC ) );
  SetWindowLong( GridX.Handle, GWL_WNDPROC, LongInt( GridXWndProc ) );

  GridYWndProc := classes.MakeObjectInstance( GridYCustomWndProc );
  GridYSaveWndProc := Pointer( GetWindowLong( GridY.Handle, GWL_WNDPROC ) );
  SetWindowLong( GridY.Handle, GWL_WNDPROC, LongInt( GridYWndProc ) );
end;

procedure TForm1.GridXCustomWndProc( var Msg: TMessage );
begin
   Msg.Result := CallWindowProc( GridXSaveWndProc, GridX.Handle, Msg.Msg, Msg.WParam, Msg.LParam );
   case Msg.Msg of
      WM_KEYDOWN:
      begin
         case TWMKey( Msg ).CharCode of VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
            GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
         end;
      end;
      WM_VSCROLL:
         GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      WM_HSCROLL:
         GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      WM_MOUSEWHEEL:
      begin
         ActiveControl := GridY;
         GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      end;
      WM_DESTROY:
      begin
         SetWindowLong( GridX.Handle, GWL_WNDPROC, Longint( GridXSaveWndProc ) );
         Classes.FreeObjectInstance( GridXWndProc );
      end;
  end;
end;

procedure TForm1.GridXMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
   GridY.SetActiveRow( GridX.GetActiveRow );
end;

procedure TForm1.GridYCustomWndProc( var Msg: TMessage );
begin
   Msg.Result := CallWindowProc( GridYSaveWndProc, GridY.Handle, Msg.Msg, Msg.WParam, Msg.LParam );
   case Msg.Msg of
      WM_KEYDOWN:
      begin
         case TWMKey( Msg ).CharCode of VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
            GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
         end;
      end;
      WM_VSCROLL:
         GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      WM_HSCROLL:
         GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      WM_MOUSEWHEEL:
      begin
         ActiveControl := GridX;
         GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      end;
      WM_DESTROY:
      begin
         SetWindowLong( GridY.Handle, GWL_WNDPROC, Longint( GridYSaveWndProc ) );
         Classes.FreeObjectInstance( GridYWndProc );
      end;
   end;
end;

procedure TForm1.GridYMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
   GridX.SetActiveRow( GridY.GetActiveRow );
end;

.

ソリューションのためのSertac Akyuz。グリッドを使用してVCLフォームアプリケーションに統合されている場合、それらはスクロールしていると、選択したレコードを強調表示します。

Answer 1

あなたはおそらく両方のグリッドのためにメッセージの上書きを実装しています。GridXはGridyをスクロールします。これはGridXをスクロールします。ブロックをフラグを囲むことで表面的なスクロールコードを保護することができます。

type
  TForm1 = class(TForm)
    [..] 
  private
    FNoScrollGridX, FNoScrollGridY: Boolean;
    [..]

procedure TForm1.GridXCustomWndProc( var Msg: TMessage );
begin
  Msg.Result := CallWindowProc(POldWndProc, gridX.Handle, Msg.Msg, Msg.wParam, Msg.lParam );

  if ( Msg.Msg = WM_VSCROLL ) then 
  begin
    if not FNoScrollGridX then
    begin
      FNoScrollGridX := True
      gridY.SetActiveRow( gridX.GetActiveRow );
      gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam );
//      SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True );
    end;
    FNoScrollGridX := False;
  end;
end;

.

グリディーのシイムなコード。BTW、あなたはSetScrollposを必要としない。

---

編集：

TForm1 = class(TForm)
  [..]
private
  GridXWndProc, GridXSaveWndProc: Pointer;
  GridYWndProc, GridYSaveWndProc: Pointer;
  procedure GridXCustomWndProc(var Msg: TMessage);
  procedure GridYCustomWndProc(var Msg: TMessage);
  [..]

procedure TForm1.FormCreate(Sender: TObject);
begin
  [..]

  GridXWndProc := classes.MakeObjectInstance(GridXCustomWndProc);
  GridXSaveWndProc := Pointer(GetWindowLong(GridX.Handle, GWL_WNDPROC));
  SetWindowLong(GridX.Handle, GWL_WNDPROC, LongInt(GridXWndProc));

  GridYWndProc := classes.MakeObjectInstance(GridYCustomWndProc);
  GridYSaveWndProc := Pointer(GetWindowLong(GridY.Handle, GWL_WNDPROC));
  SetWindowLong(GridY.Handle, GWL_WNDPROC, LongInt(GridYWndProc));
end;

procedure TForm1.GridXCustomWndProc(var Msg: TMessage);
begin
  Msg.Result := CallWindowProc(GridXSaveWndProc, GridX.Handle,
      Msg.Msg, Msg.WParam, Msg.LParam);

  case Msg.Msg of
    WM_KEYDOWN:
      begin
        case TWMKey(Msg).CharCode of
          VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
            GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
        end;
      end;
    WM_VSCROLL: GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
    WM_MOUSEWHEEL:
      begin
        ActiveControl := GridY;
        GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
      end;
    WM_DESTROY:
      begin
        SetWindowLong(GridX.Handle, GWL_WNDPROC, Longint(GridXSaveWndProc));
        Classes.FreeObjectInstance(GridXWndProc);
      end;
  end;
end;

procedure TForm1.GridYCustomWndProc(var Msg: TMessage);
begin
  Msg.Result := CallWindowProc(GridYSaveWndProc, GridY.Handle,
      Msg.Msg, Msg.WParam, Msg.LParam);

  case Msg.Msg of
    WM_KEYDOWN:
      begin
        case TWMKey(Msg).CharCode of
          VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
            GridX.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
        end;
      end;
    WM_VSCROLL: GridX.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
    WM_MOUSEWHEEL:
      begin
        ActiveControl := GridX;
        GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
      end;
    WM_DESTROY:
      begin
        SetWindowLong(GridY.Handle, GWL_WNDPROC, Longint(GridYSaveWndProc));
        Classes.FreeObjectInstance(GridYWndProc);
      end;
  end;
end;

.

Answer 2

私は部分的に、今ではフルワーキングソリューション（少なくとも2つのTMEMOの場合）...

私は部分的な意味であるため、1つのTMEMOの変更についてのみ聞こえますが、もう一方のTMEMOでは聴いていません...

私は行われているものには依存しないため、完全な作業を意味します...

それは他のメモに同じ水平スクロール値を置くのと同じくらい簡単です...

メッセージには何も関係ありませんが、メッセージを閉じ込めてwm_hscrollなどで作業解を取得しようとしていたので...それが機能するのでコードを残しました...私は後でそれを改善しようとします...例では、または他の方法でのみトラッピングします。しかし、今のところ、私はそれがうまくいってからそれを持っているようにそれを置きます...そして私はまだより良い何かを見つけませんでした...

これは機能するコードです：

// On private section of TForm1
Memo_OldWndProc:TWndMethod; // Just to save and call original handler
procedure Memo_NewWndProc(var TheMessage:TMessage); // New handler

// On implementation section of TForm1    
procedure TForm1.FormCreate(Sender: TObject);
begin
     Memo_OldWndProc:=Memo1.WindowProc; // Save the handler
     Memo1.WindowProc:=Memo_NewWndProc; // Put the new handler, so we can do extra things
end;

procedure TForm1.Memo_NewWndProc(var TheMessage:TMessage);
begin
     Memo_OldWndProc(TheMessage); // Let the scrollbar to move to final position
     Memo2.Perform(WM_HSCROLL
                  ,SB_THUMBPOSITION+65536*GetScrollPos(Memo1.Handle,SB_HORZ)
                  ,0
                  ); // Put the horizontal scroll of Memo2 at same position as Memo1
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     Memo1.WindowProc:=Memo_OldWndProc; // Restore the old handler
end;

.

変更するためにスクロールするためのすべての方法で機能します...

注：

• 私はそれがすべてのメッセージを閉じ込めることが恐ろしいことですが、少なくとも作品...
• これは私の最初の成功した2つのtmemosを同期させようとした試みです 水平スクロールバー...
• だから、誰かがそれを少し改善できるならば（すべてのメッセージを罠にかけない） それをやりなさい。
• Memo2 Barとの水平同期にあるだけでなく、そうではありません。 MEMO1と同期しているMEMO2
• キーを押し上げ、下、左、右、マウスホイールなど... action
でそれを見るためにメモ2で欲しいです

私はそれを改善しようとします：Memo2で何かをするとき、Memo1スクロールはまだ同期しています...

スクロールバーを持つすべてのコントロール、TMEMOだけでなく、常に機能できると思います...

Answer 3

私が言ったように...

ここでは効率、クリーンなコード、双方向の面で優れたソリューション（最終的なものではありません）です...どれでも他のものに影響を与えます...

各文に何を理解するためにコードでコメントを読んでください...それはかなり難しいです...しかし主なアイデアは以前と同じです...他のTMEMO水平スクロールバーをそのままにします。ユーザーが行動している場合...マウスを移動してテキストを移動してテキストを選択しても、左、右、ホーム、エンドキーを押して、マウス横ホイール（すべてが1つ持てない）を使用し、SROLLBARをドラッグし、任意の部分を押します。水平スクロールバーなどの...

主なアイデアは...オブジェクトを再描画する必要があるので、その他のオブジェクト水平スクロールバーをこの1つのものと同じ...

この最初の部分は、TMEMOクラスに物事を追加するためだけに、新しい派生クラスを作成するだけですが、同じクラス名ではなく、宣言内の単位専用です。

TFORM宣言の前にこのインターフェースセクションに追加するため、TFORMは通常1ではなくこの新しいTMEMOクラスを表示します。

type
    TMemo=class(StdCtrls.TMemo) // Just to add things to TMemo class only for this unit
    private
       BusyUpdating:Boolean; // To avoid circular stack overflow
       SyncMemo:TMemo; // To remember the TMemo to be sync
       Old_WindowProc:TWndMethod; // To remember old handler
       procedure New_WindowProc(var Mensaje:TMessage); // The new handler
    public
       constructor Create(AOwner:TComponent);override; // The new constructor
       destructor Destroy;override; // The new destructor
    end;

.

この次の部分は、その新しいTMEMOクラスの以前の宣言の実装です。

この設定を可能にする任意の場所にこれを追加します。

constructor TMemo.Create(AOwner:TComponent); // The new constructor
begin
     inherited Create(AOwner); // Call real constructor
     BusyUpdating:=False; // Initialize as not being in use, to let enter
     Old_WindowProc:=WindowProc; // Remember old handler
     WindowProc:=New_WindowProc; // Replace handler with new one
end;

destructor TMemo.Destroy; // The new destructor
begin
     WindowProc:=Old_WindowProc; // Restore the original handler
     inherited Destroy; // Call the real destructor
end;

procedure TMemo.New_WindowProc(var Mensaje:TMessage);
begin
     Old_WindowProc(Mensaje); // Call the real handle before doing anything
     if  BusyUpdating // To avoid circular stack overflow
       or
         (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow)
       or
         (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed
     then Exit; // Do no more and exit the procedure
     BusyUpdating:=True; // Set that object is busy in our special action
     SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo
     BusyUpdating:=False; // Set that the object is no more busy in our special action
end;

.

最後の部分で、各TMEMOに同期しなければならない他のメモとは何ですか。

実装セクションでは、form1 createイベントの場合、次のようなものを追加します。

procedure TForm1.FormCreate(Sender: TObject);
begin
     Memo1.SyncMemo:=Memo2; // Tell Memo1 what TMemo must sync (Memo2)
     Memo2.SyncMemo:=Memo1; // Tell Memo2 what TMemo must sync (Memo1)
end;

.

私たちの特別な新しいTMEMOクラスにSyncMemoメンバーを追加しました、これはそこにいました。

これを完全に作用させるためにTMEMO JSUTの両方のための少し設定：

• 両方のTMEMOスクロールバーを表示させる
• tmemo
の両方でwordwrap falseをfalse let
• 多くのテキスト（両方とも同じ）、長い行と行の線

それを実行して、Syncの両方の水平スクロールバーがAllways ...

の両方を参照してください。

• 1つの水平スクロールバーを移動すると、他の水平スクロールバー 移動...
• テキストに右または左に行く場合は、回線の開始または行末の終わり、 etc ...他のもののSELSTARTがどこにあるかに関係なく...水平 テキストスクロールが同期しています。

これが最終版ではない理由は、

• スクロールバー（私の場合の水平方向の1つ）を隠すことはできません...隠されていない場合は、getScrollposを呼び出すときはゼロを返します。

隠されたgetScrollposをゼロに戻すことをどのようにエミュレートするかを誰かが知っている場合は、コメントしてください、それは私が最終バージョンのために修正する必要があるだけです。

注：

• 明らかに同じことが垂直スクロールバーで行うことができます... wm_hscrollからwm_vscrollとsb_horzからsb_vert
へ
• も同時に同じことができます... SyncMemo.perform行を2回コピーするだけで、WM_HSCROLLとSB_HORZとSB_HORZを使用してWM_VSCROLLとSB_VERT
を使用します。

ここは、Sync Sync ScrollBarsの場合と同時に、Copy＆Pasteのような人々のための怠惰な人々のためのnew_windowprocプロシージャの例です。

procedure TMemo.New_WindowProc(var Mensaje:TMessage);
begin
     Old_WindowProc(Mensaje); // Call the real handle before doing anything
     if  BusyUpdating // To avoid circular stack overflow
       or
         (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow)
       or
         (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed
     then Exit; // Do no more and exit the procedure
     BusyUpdating:=True; // Set that object is busy in our special action
     SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo
     SyncMemo.Perform(WM_VSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_VERT),0); // Send to the other TMemo a message to set its vertical scroll as it is on this TMemo
     BusyUpdating:=False; // Set that the object is no more busy in our special action
end;

.

誰かが隠し1つのスクロールバーとgetScrollposの問題を解決できることを願っています!!!

Answer 4

私は解決策を見つけました...私はそれがかなり難しいことを知っています...しかし少なくともそれは完全に機能的です...

水平スクロールバーを隠す代わりに...私はそれを目に見える領域から表示させるので、それはユーザーには見えない...

トリッキーな部分：

• tmemoがtpanel
の内側にtmemoを置くtpanelを置く
• TPANELの枠線を隠し、ボーダーウィスを0とし、すべてのベベルをBVNONE / BKNONE
• TMEMOをAltopに設定して、allyientなどではありません...
• tpanel.heightをtpanel.heightにするためにtpanel.heightをハンドルします。 / li>

それは...終わった！水平スクロールバーは目に見える領域外です...あなたが望むサイズをそれに与える場所を置くことができます。 ...私は知っていますが、完全に機能的です。

これはそれをアーカイブするためのフルコードです：

Interfaceセクションでは、TFORM宣言の前に、TFORMは通常1の代わりにこの新しいTMEMOクラスを表示します。

type
    TMemo=class(StdCtrls.TMemo) // Just to add things to TMemo class only for this unit
    private
       BusyUpdating:Boolean; // To avoid circular stack overflow
       SyncMemo:TMemo; // To remember the TMemo to be sync
       Old_WindowProc:TWndMethod; // To remember old handler
       procedure New_WindowProc(var Mensaje:TMessage); // The new handler
    public
       constructor Create(AOwner:TComponent);override; // The new constructor
       destructor Destroy;override; // The new destructor
    end;

.

実装セクションonewhereあなたが優先されます：

constructor TMemo.Create(AOwner:TComponent); // The new constructor
begin
     inherited Create(AOwner); // Call real constructor
     BusyUpdating:=False; // Initialize as not being in use, to let enter
     Old_WindowProc:=WindowProc; // Remember old handler
     WindowProc:=New_WindowProc; // Replace handler with new one
end;

destructor TMemo.Destroy; // The new destructor
begin
     WindowProc:=Old_WindowProc; // Restore the original handler
     inherited Destroy; // Call the real destructor
end;

procedure TMemo.New_WindowProc(var Mensaje:TMessage);
begin
     Old_WindowProc(Mensaje); // Call the real handle before doing anything
     if  (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed
       or
         BusyUpdating // To avoid circular stack overflow
       or
         (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow)
     then Exit; // Do no more and exit the procedure
     BusyUpdating:=True; // Set that object is busy in our special action
     SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo
     BusyUpdating:=False; // Set that the object is no more busy in our special action
end;

.

実装課でも任意の場所に設定します。

procedure TForm1.FormCreate(Sender: TObject);
begin
     Memo1.SyncMemo:=Memo2; // Tell Memo1 what TMemo must sync (Memo2)
     Memo2.SyncMemo:=Memo1; // Tell Memo2 what TMemo must sync (Memo1)
end;

procedure TForm1.pnlMemo2Resize(Sender: TObject);
begin
     Memo2.Height:=pnlMemo2.Height+20; // Make height enough big to cause horizontal scroll bar be out of TPanel visible area, so it will not be seen by the user
end;

.

ThasのIT人！私はそれがかなり難しいですが、完全に機能的です。

New_WindowProcでは、または条件を評価する順序を変更しました...他のすべてのメッセージのスピードを向上させることであるため、すべてのメッセージ処理を可能な限り少ない遅延です。

現実の（計算または読み取りされた）TMEMO水平スクロールバーの高さでそのような20を交換する方法を知っています。

Answer 5

GetSystemMetricsとSM_CYHSCROLLをありがとうが、それはほとんど... 3ピクセルが必要です...

だから私は単なる使用：GetSystemMetrics(SM_CYHSCROLL)+3

注：そのようなピクセルのうちの2つは、BevelWidthを使用して1を持つ親パネルを持つが、BevelInnerとBevelOuterを使用してbvNoneを持つためです。しかし、私が理由がわからない余分なピクセル。

たくさんありがとう。

あなたが好む場合は、それらを1つの大きな投稿に参加させますが、それはそれらを混合しないほうがいいと思います。

「Sertac Akyuz」に答えて（ここでそれをして申し訳ありませんが、私はあなたの質問の横に投稿する方法がわかりません）：

• 私は私が彼らを見つけたように私が見つけた解決策をここに置いた...私の意図は スクラッチパッドとして使用しないでください...投稿を書く前にソリューションJSUT秒を取り上げました
• 倍増の編集ではなく、古い投稿を見守る方が良いと思います 同じ投稿だけであり、他の人が正確な解決策を知らせないでしょう、 そのような解決策に到達する方法も知らせます。
• 私は「与えるのではなく、釣り方法を教えるように」のように物事をすることを好む 魚 "
• これは私がしようとしていたことだけを正確にしようとしているという理由だけで新しい質問を開けませんでした

重要：スクロールを引き起こすがメッセージWM_VSCROLL、WM_HSCROLL（WM_PAINTのみ）を発生させる場合があるため、メッセージキャプチャによって完璧な解決策ができないことを発見します。マウスでテキストを選択してください。最後の視覚的な行の終わりの近くで起動し、マウスを少し停止してから、マウスの移動を停止し、マウスのボタンを押してください。何でも（マウスが動かない、キーアップ、キーダウン、マウスボタンの変更なしなど）がテキストの終わりに達するまでスクロールダウンしています...マウスが正しい端の近くにあるときに同じようになります。視線を移動して右に移動します...そのようなスクロールは、メッセージWM_VSCROLL WM_HSCROLLを介していません（少なくとも私のコンピュータ上で）...もグリッドでも同じようになります。