Synchronized Scrolling Components Delphi

I am trying to synchronize the scrolling of two TDBGrid components in a VCL Forms application, I am having difficulties intercepting the WndProc of each grid component without some stack issues. I have tried sending WM_VSCROLL messages under scrolling events but this still results in the incorrect operation. It needs to work for clicking the scrollbar, as well as highlighting a cell, or an up or down mouse button. The whole idea is to have two grids next to each other displaying a sort of matching dialog.

Tried

SendMessage( gridX.Handle, WM_VSCROLL, SB_LINEDOWN, 0 );

Also

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;

And

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;

The First is only a temporary solution, the second results in invalid memory reads, and the third results in a stack overflow. So none of these solutions seems to work for me. I'd love some input on how to accomplish this task! Thanks in advance.

UPDATE: Solution

  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;

Thanks to - Sertac Akyuz for the solution. When integrated into a VCL forms application using grids, they will mimmic each other in scrolling, and highlighting the selected record.

Solution

You are probably implementing the message override for both of the grids. GridX scrolls GridY, which in turn scrolls GridX, which in turn ... SO. You can protect the superficial scrolling code by surrounding the block with flags.

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;

Similiar code for the GridY. BTW, you shouln't need the SetScrollPos.

edit:

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;