同步滚动组件Delphi

我试图在VCL表单应用程序中同步两个TDBGrid组件的滚动，在没有堆栈问题的情况下，我很难截取每个网格组件的WndProc。我曾尝试在滚动事件下发送WM_VSCROLL消息，但这仍然会导致不正确的操作。它需要用于单击滚动条、突出显示单元格或上下鼠标按钮。整个想法是让两个网格彼此相邻，显示一种匹配对话框

尝试过

同时

和

第一个只是临时解决方案，第二个导致无效内存读取，第三个导致堆栈溢出。所以这些解决方案似乎都不适合我。我想知道如何完成这项任务！提前谢谢

更新：解决方案

---

感谢-Sertac Akyuz提供的解决方案。当使用网格集成到VCL表单应用程序中时，它们将在滚动和突出显示所选记录时相互MIMIC。

您可能正在为两个网格实现消息覆盖。GridX滚动GridY，GridY依次滚动GridX，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;

网格的类似代码。顺便说一句，你不应该需要设置crollpos。

---

编辑：

---

我得到了一个部分的，但现在完整的工作解决方案（至少两个TMemo）

我的意思是部分的，因为它只在一个TMemo上侦听更改，而在另一个TMemo上不侦听更改

我的意思是充分的工作，因为它不取决于做了什么

这就像在一个备忘录上放置和在另一个备忘录上相同的水平滚动值一样简单

它与消息无关，但由于我试图通过捕获消息WM_HSCROLL等获得一个有效的解决方案。。。我留下代码是因为它能工作。。。我以后会努力改进的。。。例如，仅捕获WM_油漆，或以其他方式。。。但现在，我把它放在我现在的位置，因为它是有效的。。。我没有找到更好的地方

以下是有效的代码：

// 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;

它适用于所有方式，使滚动更改

注:

• 我知道捕获所有消息是很可怕的，但至少有效
• 这是我第一次成功尝试将两个TMemos与同步 水平滚动条
• 所以，如果有人可以改进它一点（不是陷阱所有的消息）请 做它，并张贴它
• 它只会使Memo1与Memo2条水平同步，但不会 备忘录2与备忘录1同步
• 按上、下、左、右、鼠标滚轮等键。。。随便你 想在备忘录2上看到它的实际行动吗

我将尝试改进它：当在备忘录2上执行某些操作时，备忘录1滚动仍处于同步状态

我认为它可以适用于所有具有滚动条的控件，而不仅仅是TMemo…

正如我所说的那样

在这里，它是一个更好的解决方案（不是最终解决方案），在效率方面，干净的代码和双向。。。改变任何一个都会影响另一个

请阅读代码上的注释，了解每个句子的含义。。。这是相当棘手的。。。但是主要的想法和以前一样。。。将另一个TMemo水平滚动条设置为用户正在操作的TMemo上的状态。。。无论用户做什么，移动鼠标并选择文本，按左键、右键、主键、结束键，使用鼠标水平滚轮（并非所有滚轮都有），拖动滚动条，按水平滚动条的任何部分，等等

主要的想法是。。。该对象需要重新绘制，然后将另一个对象放置在与此对象相同的水平滚动条上

第一部分只是向TMemo类添加内容，它只是创建一个新的派生类，但具有相同的类名，但仅用于声明的单元

在您的TForm声明之前，将其添加到interface部分，以便您的TForm将看到这个新的TMemo类，而不是普通的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;

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;

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;

请记住，我们已经将SyncMemo成员添加到我们的新TMemo类中，它就是为了这个，告诉对方一个是另一个

现在对两个TMemo jsut进行一点配置，以使其完美工作：

• 让两个TMemo滚动条都可见
• 让WordWrap在两个Tmemo上都为false
• 放大量的文字（两者相同）、长行和大量的行

运行它，看看两个水平滚动条是如何始终同步的

• 如果移动一个水平滚动条，则移动另一个水平滚动条 移动
• 如果您在文本上向右或向左移动，行开始或行结束， 等等，不管另一边的SelStart在哪里。。。水平面 文本滚动处于同步状态

这不是最终版本的问题在于：

• 滚动条（在我的例子中是水平的）无法隐藏。。。因为如果一个是隐藏的，当调用GetScrollPos时，它返回零，所以使它不同步

如果有人知道如何模拟隐藏或使GetScrollPos不返回零，请评论，这是我需要为最终版本修复的唯一问题

注:

• 显然，垂直滚动条也可以做到这一点。。。换衣服 从Hscoll到Vscoll和从HORZ到SbVert
• 显然，这两种方法可以同时适用于。。。只需复制SyncMemo。执行两行，一行让WM_Hscoll和SB_HORZ，另一行让WM_Vscoll和SB_VERT

下面是一个新的\u 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;

procedure TMemo.New_WindowProc（var Mensaje:TMessage）；
开始
Old_WindowProc（Mensaje）；//在做任何事情之前先打电话给真正的把手
如果总线更新//以避免c
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;

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 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;

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;

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;