同步滚动组件Delphi

我试图在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.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,True );
   end;
   inherited WndProc( Msg );
end;

First只是一个临时解决方案,第二个导致无效的内存读取,第三个导致堆栈溢出.所以这些解决方案似乎都不适用于我.我喜欢关于如何完成这项任务的一些意见！提前致谢.

更新：解决方案

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,LongInt( GridYWndProc ) );
end;

procedure TForm1.GridXCustomWndProc( var Msg: TMessage );
begin
   Msg.Result := CallWindowProc( GridXSaveWndProc,GridX.Handle,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.LParam );
         end;
      end;
      WM_VSCROLL:
         GridY.Perform( Msg.Msg,Msg.LParam );
      WM_HSCROLL:
         GridY.Perform( Msg.Msg,Msg.LParam );
      WM_MOUSEWHEEL:
      begin
         ActiveControl := GridY;
         GridY.Perform( Msg.Msg,Msg.LParam );
      end;
      WM_DESTROY:
      begin
         SetWindowLong( GridX.Handle,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,VK_NEXT:
            GridX.Perform( Msg.Msg,Msg.LParam );
         end;
      end;
      WM_VSCROLL:
         GridX.Perform( Msg.Msg,Msg.LParam );
      WM_HSCROLL:
         GridX.Perform( Msg.Msg,Msg.LParam );
      WM_MOUSEWHEEL:
      begin
         ActiveControl := GridX;
         GridX.Perform( Msg.Msg,Msg.LParam );
      end;
      WM_DESTROY:
      begin
         SetWindowLong( GridY.Handle,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表单应用程序中时,它们将在滚动时相互模仿,并突出显示所选记录.

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

procedure TForm1.GridXCustomWndProc( var Msg: TMessage );
begin
  Msg.Result := CallWindowProc(POldWndProc,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.lParam );
//      SetScrollPos( gridY.Handle,True );
    end;
    FNoScrollGridX := False;
  end;
end;

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,LongInt(GridXWndProc));

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

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

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

procedure TForm1.GridYCustomWndProc(var Msg: TMessage);
begin
  Msg.Result := CallWindowProc(GridYSaveWndProc,VK_NEXT:
            GridX.Perform(Msg.Msg,Msg.LParam);
        end;
      end;
    WM_VSCROLL: GridX.Perform(Msg.Msg,Msg.LParam);
    WM_MOUSEWHEEL:
      begin
        ActiveControl := GridX;
        GridY.Perform(Msg.Msg,Msg.LParam);
      end;
    WM_DESTROY:
      begin
        SetWindowLong(GridY.Handle,Longint(GridYSaveWndProc));
        Classes.FreeObjectInstance(GridYWndProc);
      end;
  end;
end;