•  26-09-2020
  •  | 
  •  

题

我正在尝试在VCL Forms应用程序中同步两个TDBGrid组件的滚动，我在拦截每个网格组件的WndProc时遇到困难而没有一些堆栈问题。我已经尝试在滚动事件下发送WM_VSCROLL消息，但这仍然导致错误的操作。它需要用于单击滚动条，以及突出显示单元格或向上或向下鼠标按钮。整个想法是让两个网格彼此相邻，显示一种匹配的对话框。

尝试过

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;

第一个只是临时解决方案，第二个导致无效的内存读取，第三个导致堆栈溢出。所以这些解决方案似乎都不适合我。我很乐意就如何完成这项任务提供一些意见！先谢谢你。

更新资料:解决方案

  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窗体应用程序中时，它们将在滚动中相互混合，并突出显示所选记录。

有帮助吗？

解决方案

您可能正在实现两个网格的消息覆盖。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;
.

格栅的类似码。顺便说一句，你不需要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;
.

其他提示

我有一个部分，但现在完整的工作解决方案（至少两个tmemo）...

我的意思是部分，因为它只侦听一个TMEMO的更改，但不是另一个...

我的意思是完全工作，因为它不依赖于所做的内容...

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

它与消息没有任何关系，但是由于我试图通过捕获消息wm_hscroll等来获得工作解决方案......我离开了代码，因为它有效......我会尽力改善它......仅拍摄wm_paint，或以其他方式捕获......但是现在，我把它放在那以后，因为它有效......我没有找到任何东西，更好的东西...

这是工作的代码：

// 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与备忘录2栏的水平同步，但不是 memo2与memo1
    • 同步
  • 按键，向下，向左，右，鼠标轮等......无论您是什么 想要，但在备忘录中看到它在动作中看到它

我会尝试改进它：在备忘录中做某事时，Memo1滚动仍然在同步...

我认为它可以用于满足有一个滚动条的任何控件，不仅是tmemo ...

我告诉...

在这里，它是一个更好的解决方案（不是最终一），在效率，清洁代码和双向......改变任何一个人影响其他...

请阅读关于代码的评论以了解每个句子的内容......它非常棘手......但主要想法与之前的相同...设置另一个TMEM水平滚动栏用户行动的TMEMO ...无论用户所做的，移动鼠标和选择文本，按左，右，家，结束键，使用鼠标水平轮（并非全部有一个），拖动SROLLBAR，按任意部分按下水平滚动条等...

主要思想是......对象需要重新绘制，因此将另一个对象水平滚动条与此相同...

这个第一部分只是为了将事情添加到TMEMO类，它只是创建一个新的派生类，但具有相同的类名，但仅针对声明的单位。

将此添加到接口部分，在您的TForm声明之前，因此您的TForm将看到这个新的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类声明的实现。

将其添加到Preffer的任何地方：

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必须符合同步的其他备忘录。

在您的实现部分中，for form1创建事件添加如下所示：

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

记住我们已添加SyncMemo成员到我们的特殊新的TMEMO类，它就是这样，互相告诉彼此是另一个。

现在是TMEMO JSUT的一点配置，让这项工作完美：

  • 让TMEMO滚动条可见
    • 让WordWrap在TMEMO 上虚假
  • 为两种文字（相同），长线和大量的线条

运行它，看看Sync ...

的两条水平滚动条是如何

  • 如果移动一个水平滚动条，另一个水平滚动条 移动...
  • 如果您在右侧或左侧的文本上，行开始或线条， 等等......，无论是塞尔斯特还在哪里......水平 文本滚动是同步的。

为什么这不是最终版本：

  • 滚动条（我的情况下的水平）无法隐藏......因为如果一个被隐藏，则在调用getscrollpos时，它会返回零，所以使其不同步。

如果有人知道如何模拟隐藏或使getscrollpos不要返回零，请评论，它是我唯一需要修复最终版本的东西。

注意：

  • 显然可以用垂直滚动条完成......只是改变 wm_hscroll到wm_vscroll和sb_horz到sb_vert
  • 显然，两者都可以同时为...只是复制syncmemo.perform线两次，一个让wm_hscroll和sb_horz，另一个让wm_vscroll和sb_vert

这是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;
.

希望有人可以解决隐藏的一个滚动条和getscrollpos返回零!!!

我找到了一个解决方案......我知道它非常棘手...但至少它是完全职能的...

而不是尝试隐藏水平滚动条......我使它显示出可见区域，因此用户无法看到...

棘手的部分：

  • 放入TPanel，TMEMO是并将TMEMO放在TPanel内部
    • 内部
  • 隐藏tpanel边框，将边界绑定为0，所有斜面都到bvnone / bknone
  • 配置tmemo对齐与Altop，而不是Allient等...
  • 句柄tpanel.onresize制作tmemo.height大于tpanel.height和水平滚动条高度一样多（到目前为止，我使用恒定值20像素，但我想知道如何获得实际值）< / li>
这就是......完成!!!水平滚动条是不可见的区域......你可以放在你想要的地方，给它你想要的大小......横向滚动条不会被用户看到，它没有隐藏，所以getscrollpos将正常工作......我知道的棘手，而是功能齐全。

这是归档的完整代码：

在接口部分，在tform声明之前，所以你的tform将看到这个新的tmemo类而不是正常的tmer：

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

在实施部分您的Preffer：

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

还要在Preffer的任何地方的实施部分：

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

是它的人！我知道它是非常棘手的，而是全功能。

请注意，我已在new_windowproc上更改了评估或条件的顺序...它只是为了提高所有其他消息的速度，因此延迟尽可能少的消息处理。

希望有时候我会知道如何通过真实（计算或读数）tmemo水平滚动条栏高度更换20。

谢谢你 GetSystemMetrics 和 SM_CYHSCROLL, ，但它不仅仅是enought。..只需要多3个像素。..

所以我只是用: GetSystemMetrics(SM_CYHSCROLL)+3

注:两个这样的像素可能是因为有父面板与 BevelWidth 具有价值 1 但我有 BevelInner 和 BevelOuter 具有价值 bvNone 所以可能不会;但额外的像素，我不知道为什么。

非常感谢！.

如果你preffer，只需加入他们到一个大帖子，但我认为最好不要混合它们。

在回答"Sertac Akyuz"（很抱歉在这里做，但我不知道如何将它们贴在你的问题旁边）:

  • 我把我找到的解决方案放在这里。..我的意图是 不要把它当作擦伤垫。..在写帖子之前，我把解决方案jsut秒了
  • 我认为最好是看到旧的帖子，而不是编辑。 时间只是同一个帖子。..它也不会让其他人知道确切的解决方案, 也会让他们知道如何达到这样的解决方案。
  • 我喜欢用"教如何钓鱼"这样的方式做事，而不是给 鱼"。
  • 我没有打开一个新的问题，只是因为这个问题的标题正是我想要做的

重要事项:我发现一个完美的解决方案不能通过消息捕获来完成，因为有一种情况导致滚动但没有消息 WM_VSCROLL, WM_HSCROLL （只 WM_PAINT)...它与用鼠标选择文本有关。..让我解释一下我是如何看待它的。..只需从最后一条视觉线的末尾开始，将鼠标向下移动一点，然后停止鼠标移动，让鼠标按钮按下。..没有做任何事情（鼠标不移动，没有keyup，没有keydown，没有鼠标按钮更改等。..）TMemo正在向下滚动，直到到达文本的末尾。..当鼠标靠近可视线的右端并向右移动时，水平滚动也会发生同样的情况。..在相反的方向上也是一样的。..这样的滚动不通过消息 WM_VSCROLL WM_HSCROLL, ，只 WM_PAINT （至少在我的电脑上）。..网格也是如此。

许可以下： CC-BY-SA 和 归因
不隶属于 StackOverflow
scroll top