代码之家  ›  专栏  ›  技术社区  ›  wfoster

同步滚动组件Delphi

  •  5
  • wfoster  · 技术社区  · 14 年前

    我正在尝试同步VCL窗体应用程序中两个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窗体应用程序中时,它们将在滚动和突出显示所选记录时互相模仿。

    5 回复  |  直到 12 年前
        1
  •  3
  •   Sertac Akyuz    14 年前

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

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


    编辑:
    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;
    
        2
  •  3
  •   z666zz666z    12 年前

    我得到了一个部分的,但现在完整的工作解决方案(至少两个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;
    

    它适用于所有方式使滚动改变…

    笔记:

    • 我知道捕捉所有的信息是很可怕的,但至少可以…
    • 这是我第一次成功尝试同步两个tmemo 水平滚动条…
    • 所以,如果有人能稍微改进一下(不是把所有的信息都设陷阱),请 把它贴出来。
    • 它只会使memo1与memo2条保持水平同步,但不会 MEMO2与MEMO1同步
    • 按上、下、左、右、鼠标跟等键…无论你 希望但在memo2上看到它的作用

    我将尝试改进它:当在memo2上做一些事情时,memo1滚动仍然是同步的…

    我认为它可以为所有大多数有滚动条的控件工作,而不仅仅是tmemo…

        3
  •  2
  •   z666zz666z    12 年前

    正如我所说的…

    在效率、干净的代码和双向性方面,这是一个更好的解决方案(而不是最终的解决方案)。任何一个改变都会影响另一个…

    请阅读对代码的评论,了解每个句子是什么…这很棘手…但主要的想法和以前一样…将另一个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;
    

    下一部分是新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创建事件,添加如下内容:

    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滚动条都可见
    • 让两个tmemo上的wordwark都为false
    • 放置大量文本(两者相同)、长行和大量行

    运行它,看看两个水平滚动条是如何同步的…

    • 如果移动一个水平滚动条,则另一个水平滚动条 移动…
    • 如果您将文本向右或向左、行首或行尾, 等等……不管selstart在哪…水平的 文本滚动处于同步状态。

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

    • 滚动条(在我的例子中是水平的)不能隐藏…因为如果一个是隐藏的,那么在调用getscrollpos时,它将返回零,因此使它不同步。

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

    笔记:

    • 显然,垂直滚动条也可以做到这一点…只是改变 wm_hscroll到wm_vscroll,sb_horz到sb_vert
    • 很明显,这两种方法可以同时进行……只需复制同步备忘录。执行两行,一行让wm_hscroll和sb_horz,另一行让wm_vscroll和sb_vert

    以下是同步两个滚动条的新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返回零的问题!!!!

        4
  •  2
  •   z666zz666z    12 年前

    我找到了解决办法…我知道这很棘手…但至少它是完全正常的…

    而不是试图隐藏水平滚动条…我使它显示在可见区域之外,所以用户看不到它…

    棘手的部分:

    • 将t面板放在tmemo所在的位置,并将tmemo放在t面板内
    • 隐藏面板边框,将borderwith设为0,所有斜面均为bvnone/bknone
    • 配置tmemo对齐到altop,而不是alclient等…
    • 处理tpanel.onResize,使tmemo.height大于tpanel.height,与水平滚动条height相同(此时我使用的是20像素的常量值,但我想知道如何获取实际值)

    就是这样…完成!!!!水平滚动条超出可见区域…你可以放在你想要的地方,给它你想要的尺寸…水平滚动条不会被用户看到,也不会被隐藏,所以getscrollpos将正常工作…我知道很棘手,但功能齐全。

    以下是存档的完整代码:

    在接口部分的tform声明之前,因此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;
    

    在您预先输入的任何地方的实现部分:

    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;
    

    就是这样,伙计们!我知道这很棘手,但功能齐全。

    请注意,我已经在新的WindowProc上更改了评估或条件的顺序…它只是为了提高所有其他消息的速度,所以尽可能减少所有消息的处理延迟。

    希望有一天我会知道如何用实际的(计算的或读取的)tmemo水平滚动条高度来替换这20个。

        5
  •  1
  •   z666zz666z    12 年前

    谢谢 GetSystemMetrics SM_CYHSCROLL 但这不仅仅是…只需要3个像素…

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

    注意:其中两个像素可能是因为父面板 BevelWidth 有价值 1 但我有 BevelInner BevelOuter 有价值 bvNone 所以可能不会,但是额外的像素我不知道为什么。

    谢谢。

    如果你预先准备好了,就把它们放在一个大的帖子里,但我认为最好不要把它们混在一起。

    在回答“Sertac Akyuz”时(很抱歉在这里这么做,但我不知道如何在您的问题旁边发布它们):

    • 我把我找到的解决方案放在这里。我的目的是 不要把它当作记事本…我在写帖子前几秒钟就发现了这个解决方案。
    • 我认为最好是看到旧的帖子,而不是编辑成倍增加。 时间都一样…它也不会让其他人知道确切的解决方案, 也会让他们知道如何达到这样的解决方案。
    • 我先选择“教你钓鱼,而不是给你 “鱼”。
    • 我没有打开一个新问题,只是因为这个问题的标题正是我想做的。

    重要的 :我发现一个完美的解决方案不能通过消息捕获完成,因为有一种情况会导致滚动,但没有消息 WM_VSCROLL , WM_HSCROLL (仅) WM_PAINT )这与用鼠标选择文本有关…我来解释一下我是怎么看待它的…从最后一条可视线的末尾开始,将鼠标向下移动一点,然后停止鼠标移动并按下鼠标按钮…如果不做任何操作(鼠标不移动、没有键向上、没有键向下、没有鼠标按钮更改等),tmemo将向下滚动直到到达文本的结尾…当鼠标靠近可视线的右端并向右移动时,水平滚动也会发生同样的情况…在相反的方向也一样…这样的滚动不通过消息 WMV-VR卷轴 WMH H卷轴 ,只有 水彩画 (至少在我的电脑上)同样的情况也发生在网格上。