...synchronize the Scrolling of two TStringgrids?

{1.}

unit SyncStringGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;

type
  TSyncKind = (skBoth, skVScroll, skHScroll);
  TSyncStringGrid = class(TStringGrid)
  private
    FInSync: Boolean;
    FsyncGrid: TSyncStringGrid;
    FSyncKind: TSyncKind;
    { Private declarations }
    procedure WMVScroll(var Msg: TMessage); message WM_VSCROLL;
    procedure WMHScroll(var Msg: TMessage); message WM_HSCROLL;
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure DoSync(Msg, wParam: Integer; lParam: Longint); virtual;
  published
    { Published declarations }
    property SyncGrid: TSyncStringGrid read FSyncGrid write FSyncGrid;
    property SyncKind: TSyncKind read FSyncKind write FSyncKind default skBoth;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TSyncStringGrid]);
end;

procedure TSyncStringGrid.WMVScroll(var Msg: TMessage);
begin
  if not FInSync and
    Assigned(FSyncGrid) and
    (FSyncKind in [skBoth, skVScroll]) then
    FSyncGrid.DoSync(WM_VSCROLL, Msg.wParam, Msg.lParam);
  inherited;
end;

procedure TSyncStringGrid.WMHScroll(var Msg: TMessage);
begin
  if not FInSync and
    Assigned(FSyncGrid) and
    (FSyncKind in [skBoth, skHScroll]) then
    FSyncGrid.DoSync(WM_HSCROLL, Msg.wParam, Msg.lParam);
  inherited;
end;

procedure TSyncStringGrid.DoSync(Msg, wParam: Integer; lParam: Longint);
begin
  FInSync := True;
  Perform(Msg, wParam, lParam);
  FinSync := False;
end;

end.

{****************************************}
{2.}

private
   OldGridProc1, OldGridProc2: TWndMethod;
   procedure Grid1WindowProc(var Message: TMessage);
   procedure Grid2WindowProc(var Message: TMessage);
 public

{...}

procedure TForm1.Grid1WindowProc(var Message: TMessage);
begin
  OldGridProc1(Message);
  if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or
      Message.msg = WM_Mousewheel)) then
  begin
    OldGridProc2(Message);
  end;
end;

procedure TForm1.Grid2WindowProc(var Message: TMessage);
begin
  OldGridProc2(Message);
  if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or
     (Message.msg = WM_Mousewheel)) then
  begin
    OldGridProc1(Message);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OldGridProc1 := StringGrid1.WindowProc;
  OldGridProc2 := StringGrid2.WindowProc;
  StringGrid1.WindowProc := Grid1WindowProc;
  StringGrid2.WindowProc := Grid2WindowProc;
end;

printed from
www.swissdelphicenter.ch
developers knowledge base