Synchronized Scrolling Components Delphi

Question

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.

Seaside

Answer 1

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;

Vannie

I'm getting stack overflow errors when trying to use inherited WndProc( Msg ) Also when I have the code as you have shown I get invalid reads of memory and other runtime errors. Not sure if this is the only way to accomplish the task? – Seaside

What inherited WndProc?, you gave a code part that replaces the WindowProc of a grid. Where do you override the 'WndProc'? Please edit the question to show the relevant code. – Vannie

@Seaside - What happens when you leave out SetActiveRow? Since it's not a standard grid method I don't know how it does set the active row.. – Vannie

@Sertac Set active row only highlights the specific row in the visible rows section. I am using TwwDBGrid's paired with TkbmMemTable's I have had varied success using the .RecNo properties of the two tables. – Seaside

@Seaside - I tested the code in the updated part of the answer for 2 standard DBGrids, it wouldn't matter the grids being TwwDBGrids but please first test by leaving out all other message handling/window procedure stuff. Also leave out the SetActiveRow for testing purposes, it might be causing additional scrolling. If this test work outs, you'd be able to identify which call causes problem while putting the remaining functionality one by one. – Vannie

@Sertac - Excellent, with a sample test app your code is working as designed, It still doesn't work with the scroll wheel but I'm sure I can tweak what you have here. Thanks for the help! – Seaside

@Seaside - Thanks! I've again edited the answer a bit; to free the method instances and a suggestion for the scroll wheel/keys. Good luck! – Vannie

Answer 2

I got a partial, but now full working solution (at least for two TMemo)...

I mean partial, because it only listen for changes on one TMemo but not on the other...

I mean full working because it does not depend on what is done...

It is just as simple as put same horizontal scroll value on one Memo as it is on the other...

It is nothing related with messages, but since i was trying to get a working solution by trapping messages WM_HSCROLL, etc... i left the code because it works ... i will try to improve it later... for example trapping only WM_PAINT, or in other ways... but for now, i put it as i have it since as that it works... and i did not find anywhere something yet better...

Here is the code that works:

// On private section of TForm1
Memo_OldWndProc:TWndMethod; // Just to save and call original handler
procedure Memo_NewWndProc(var TheMessage:TMessage); // New handler

// On implementation section of TForm1    
procedure TForm1.FormCreate(Sender: TObject);
begin
     Memo_OldWndProc:=Memo1.WindowProc; // Save the handler
     Memo1.WindowProc:=Memo_NewWndProc; // Put the new handler, so we can do extra things
end;

procedure TForm1.Memo_NewWndProc(var TheMessage:TMessage);
begin
     Memo_OldWndProc(TheMessage); // Let the scrollbar to move to final position
     Memo2.Perform(WM_HSCROLL
                  ,SB_THUMBPOSITION+65536*GetScrollPos(Memo1.Handle,SB_HORZ)
                  ,0
                  ); // Put the horizontal scroll of Memo2 at same position as Memo1
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     Memo1.WindowProc:=Memo_OldWndProc; // Restore the old handler
end;

It works for all ways to make scroll to change...

Notes:

• I know it is horrible to trap all messages, but at least works...
• this is my first successfull attempt to have two TMemos with synced horizontal scrollbar...
• So, if someone can improve it a little (not trap all messages) please do it and post it.
• It only makes Memo1 to be on horizontal sync with Memo2 bar, but not Memo2 to be on sync with Memo1
• Press keys up, down, left, right, mousewheel, etc... whatever you want but on Memo2 to see it in action

I will try to improve it by: when doing something on Memo2, Memo1 scroll still be on sync...

I think it can work for allmost any control that has a ScrollBar, not only TMemo...

Monotone

Answer 3

As i told...

Here it is a better solution (not final one) in terms of efficiency, clean code and bi-directional... changing on any one affects the other...

Please, read comments on code to understand what does each sentence... it is quite tricky... but the main idea is the same as was before... set the other TMemo horizontal scroll bar as it is on the TMemo where user is acting... no matter what user does, move mouse and select text, press left, right, home, end keys, use the mouse horizontal wheel (not all have one), drag the srollbar, press on any part of the horizontal scrollbar, etc...

The main idea is... the object needs to be re-painted, so then put the other object horizontal scrollbar identical to this one...

This first part is just to add things to TMemo class, it is just creating a new derived class but with same class name, but only for the unit within declared.

Add this to interface section, before your TForm declaration, so your TForm will see this new TMemo class instead of normal one:

type
    TMemo=class(StdCtrls.TMemo) // Just to add things to TMemo class only for this unit
    private
       BusyUpdating:Boolean; // To avoid circular stack overflow
       SyncMemo:TMemo; // To remember the TMemo to be sync
       Old_WindowProc:TWndMethod; // To remember old handler
       procedure New_WindowProc(var Mensaje:TMessage); // The new handler
    public
       constructor Create(AOwner:TComponent);override; // The new constructor
       destructor Destroy;override; // The new destructor
    end;

This next part is the implementation for previous declarations of that new TMemo class.

Add this to implementation section anywhere you preffer:

constructor TMemo.Create(AOwner:TComponent); // The new constructor
begin
     inherited Create(AOwner); // Call real constructor
     BusyUpdating:=False; // Initialize as not being in use, to let enter
     Old_WindowProc:=WindowProc; // Remember old handler
     WindowProc:=New_WindowProc; // Replace handler with new one
end;

destructor TMemo.Destroy; // The new destructor
begin
     WindowProc:=Old_WindowProc; // Restore the original handler
     inherited Destroy; // Call the real destructor
end;

procedure TMemo.New_WindowProc(var Mensaje:TMessage);
begin
     Old_WindowProc(Mensaje); // Call the real handle before doing anything
     if  BusyUpdating // To avoid circular stack overflow
       or
         (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow)
       or
         (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed
     then Exit; // Do no more and exit the procedure
     BusyUpdating:=True; // Set that object is busy in our special action
     SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo
     BusyUpdating:=False; // Set that the object is no more busy in our special action
end;

Now the last part, tell each TMemo what is the other Memo that has to be on sync.

On your implementation section, for the Form1 Create event add something like this:

procedure TForm1.FormCreate(Sender: TObject);
begin
     Memo1.SyncMemo:=Memo2; // Tell Memo1 what TMemo must sync (Memo2)
     Memo2.SyncMemo:=Memo1; // Tell Memo2 what TMemo must sync (Memo1)
end;

Remember we have added SyncMemo member to our special new TMemo class, it was there just for this, tell each other what one is the other one.

Now a little configuration for both TMemo jsut to let this work perfectly:

• Let both TMemo scroll bars to be visible
• Let WordWrap false on both Tmemo
• Put a lot of text (same for both), long lines and a lot of lines

Run it and see how both horizontal scrollbars are allways on sync...

• If you move one horizontal scrollbar, the other horizontal scrollbar moves...
• If you go on the text to right or left, line start or line end, etc..., no matter where is SelStart on the other... the horizontal text scroll is on sync.

The problem why this is not a final version is that:

• The scroll bars (horizontal one in my case) can not be hidden... since if one is hidden, when calling GetScrollPos it returns zero, so makes it not be on sync.

If someone knows how to emulate hidden or make GetScrollPos to not return zero, please comment, it the only thing i need to fix for final version.

Notes:

• Obviously the same can be done with vertical scrollbar... just change WM_HSCROLL to WM_VSCROLL and SB_HORZ to SB_VERT
• Obviously the same can be done for both at the same time... just copy SyncMemo.Perform line twice and on one let WM_HSCROLL and SB_HORZ and on the other one let WM_VSCROLL and SB_VERT

Here is an example of New_WindowProc procedure for sync both scrollbars at the same time, maybe for lazy people, maybe for people just like copy&paste:

procedure TMemo.New_WindowProc(var Mensaje:TMessage);
begin
     Old_WindowProc(Mensaje); // Call the real handle before doing anything
     if  BusyUpdating // To avoid circular stack overflow
       or
         (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow)
       or
         (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed
     then Exit; // Do no more and exit the procedure
     BusyUpdating:=True; // Set that object is busy in our special action
     SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo
     SyncMemo.Perform(WM_VSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_VERT),0); // Send to the other TMemo a message to set its vertical scroll as it is on this TMemo
     BusyUpdating:=False; // Set that the object is no more busy in our special action
end;

Hope someone can fix the problem of hidden one scrollbar and GetScrollPos returning zero!!!

Monotone

Answer 4

I found a solution... i know it is quite tricky... but at least it is fully functional...

Instead of trying to hide the horizontal scroll bar... i make it to be displayed out of visible area, so it can not be seen by user...

The tricky part:

• Put a TPanel where the TMemo is and put the TMemo inside the TPanel
• Hide TPanel borders, put BorderWith as 0, and all Bevel to bvNone/bkNone
• Configure TMemo Align to alTop, not to alClient, etc...
• Handle TPanel.OnResize to make TMemo.Height bigger than TPanel.Height as much as Horizontal scrollbar height (by the moment i use a constant value of 20 pixels, but i would like to know how to get the real value)

That's it... done!!! The horizontal scroll bar is out of visible area... you can put where you want the TPanel, give it the size you want... that horizontal scrollbar will not be seen by user and it is not hidden, so GetScrollPos will work properly... tricky i know, but fully functional.

Here is the full code to archive that:

On interface section, before your TForm declaration, so your TForm will see this new TMemo class instead of normal one:

type
    TMemo=class(StdCtrls.TMemo) // Just to add things to TMemo class only for this unit
    private
       BusyUpdating:Boolean; // To avoid circular stack overflow
       SyncMemo:TMemo; // To remember the TMemo to be sync
       Old_WindowProc:TWndMethod; // To remember old handler
       procedure New_WindowProc(var Mensaje:TMessage); // The new handler
    public
       constructor Create(AOwner:TComponent);override; // The new constructor
       destructor Destroy;override; // The new destructor
    end;

On implementation section anywhere you preffer:

constructor TMemo.Create(AOwner:TComponent); // The new constructor
begin
     inherited Create(AOwner); // Call real constructor
     BusyUpdating:=False; // Initialize as not being in use, to let enter
     Old_WindowProc:=WindowProc; // Remember old handler
     WindowProc:=New_WindowProc; // Replace handler with new one
end;

destructor TMemo.Destroy; // The new destructor
begin
     WindowProc:=Old_WindowProc; // Restore the original handler
     inherited Destroy; // Call the real destructor
end;

procedure TMemo.New_WindowProc(var Mensaje:TMessage);
begin
     Old_WindowProc(Mensaje); // Call the real handle before doing anything
     if  (WM_PAINT<>Mensaje.Msg) // If not when need to be repainted to improve speed
       or
         BusyUpdating // To avoid circular stack overflow
       or
         (not Assigned(SyncMemo)) // If not yet set (see TForm1.FormCreate bwlow)
     then Exit; // Do no more and exit the procedure
     BusyUpdating:=True; // Set that object is busy in our special action
     SyncMemo.Perform(WM_HSCROLL,SB_THUMBPOSITION+65536*GetScrollPos(Handle,SB_HORZ),0); // Send to the other TMemo a message to set its horizontal scroll as it is on this TMemo
     BusyUpdating:=False; // Set that the object is no more busy in our special action
end;

Also on implementation section anywhere you preffer:

procedure TForm1.FormCreate(Sender: TObject);
begin
     Memo1.SyncMemo:=Memo2; // Tell Memo1 what TMemo must sync (Memo2)
     Memo2.SyncMemo:=Memo1; // Tell Memo2 what TMemo must sync (Memo1)
end;

procedure TForm1.pnlMemo2Resize(Sender: TObject);
begin
     Memo2.Height:=pnlMemo2.Height+20; // Make height enough big to cause horizontal scroll bar be out of TPanel visible area, so it will not be seen by the user
end;

Thas's it folks! I know it is quite tricky, but fully functional.

Please note that i have changed on New_WindowProc the order of evaluating the OR conditions... it is just to improve speed for all other messages, so delay as less as possible all the messages treatment.

Hope sometime i will know how to replace such 20 by the real (calculated or readed) TMemo horizontal scroll bar height.

Monotone

You can get the default scroll bar height with GetSystemMetrics, use SM_CYHSCROLL as nIndex.. Instead of using this question as your scratch-pad for your problem, why don't you ask a new question? – Vannie

Answer 5

Thanks for GetSystemMetrics and SM_CYHSCROLL, but it is not just enought... just need 3 pixels more...

So i just use: GetSystemMetrics(SM_CYHSCROLL)+3

Note: Two of such pixels could be because having parent panel with BevelWidth with value 1 but i have BevelInner and BevelOuter with value bvNone so may not; but the extra pixel i do not know why.

Thanks a lot.

If you preffer, just join them onto one Big post, but i think it is better not to mix them.

In answer to "Sertac Akyuz" (sorry to do it here, but i do not know how to post them next to your question):

• I put here the solutions i found as i found them... my intention was not to use it as a scratch-pad... i discobered the solution jsut seconds before writting the posts
• I think it is better to see old posts, rather than editing multiply times just the same post... it will not also let others know the exact solution, also will let them know how to reach such solution.
• I preffer to do things in a way like "teach how to fish, rather than give the fish".
• I did not open a new question just because the title of this one is just exact what i was trying to do

Important: I discover that a perfect solution can not be done by message capturing because there is a case that causes scroll but no message WM_VSCROLL, WM_HSCROLL (only WM_PAINT)... it is related to selecting text with mouse... let me explain how i see it in action... Just start near the end of last visual line and move mouse just a little down, then stop mouse move and let mouse button pressed... without doing anything (mouse does not move, no keyup, no keydown, no mouse button change, etc...) the TMemo is scrolling down till reaches the end of the text... same happens for horizontal scrolls when mouse is near the right end of visual line and moved right... also same in opposite directions... such scrolls does not through messages WM_VSCROLL WM_HSCROLL, only WM_PAINT (at least on my computer)... also same happens on Grids.

Monotone