type
  TForm1 = class(TForm)
    GridA: TStringGrid;
    GridB: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    EventRaiser: TObject;
    GridA_OrgWndProc, GridB_OrgWndProc: TWndMethod;
  public
    procedure GridA_WndProc(var Message: TMessage);
    procedure GridB_WndProc(var Message: TMessage);
  end;
 
implementation
 
procedure TForm1.FormCreate(Sender: TObject);
var
  Col, Row: Integer;
begin
  for Row := 0 to 64 - 1 do
  begin
    for Col := 0 to 64 - 1 do
    begin
      GridA.Cells[Col, Row] := IntToStr(Row) +'*'+ 
            IntToStr(Col) +'='+IntToStr(Col*Row);
      GridB.Cells[Col, Row] := IntToStr(Row) +'*'+ 
            IntToStr(Col) +'='+IntToStr(Col*Row);
    end;
  end;
 
  EventRaiser := nil;
  GridA_OrgWndProc := GridA.WindowProc;
  GridB_OrgWndProc := GridB.WindowProc;
  GridA.WindowProc := GridA_WndProc;
  GridB.WindowProc := GridB_WndProc;
end;
 
procedure TForm1.GridA_WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_VSCROLL) and (EventRaiser = nil) then
  begin
    EventRaiser := GridA;
    GridB.Perform(Message.Msg, Message.WParam, Message.LParam);
    EventRaiser := nil;
  end;
  GridA_OrgWndProc(Message);
end;
 
procedure TForm1.GridB_WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_VSCROLL) and (EventRaiser = nil) then
  begin
    EventRaiser := GridB;
    GridA.Perform(Message.Msg, Message.WParam, Message.LParam);
    EventRaiser := nil;
  end;
  GridB_OrgWndProc(Message);
end;