delphi - Delphi 同步滚动组件

Question

我正在尝试同步 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 表单应用程序中时，它们将互相模仿滚动并突出显示所选记录。

Answer 1

您可能正在为两个网格实现消息覆盖。 GridX 滚动 GridY，GridY 又滚动 GridX，GridX 又滚动……所以。您可以通过用标志包围 block 来保护表面滚动代码。

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;

GridY 的类似代码。顺便说一句，您不应该需要 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;