How do I synchronize two TMemo scrolling? [Solved]

[JohnLM 27]

Specs: delphi xe7, vcl, win7 - TMemo components 

 

I've been searching to no avail on this topic.  I can't find any example source code showing how to synchronize two memo's scrolling, via keyboard, mouse, and scrollbars.

 

I see there are a few for TListBox examples but not for TMemo. 

 

I also tried one example (it was for tlistbox) and everything compiles except that TMemo does not have a .TopIndex so that source code does not compile up to that point.

(link below). 

 

link to that resource -> https://stackoverflow.com/questions/24195857/synchronize-scrollbars-of-two-listboxes. 

 

source from stackexchange: 

To set the top line of a list box you use TopIndex.

You can create a TListbox descendent that handles the WM_VSCROLL (and WM_HSCROLL if you want). 
You can then hook into this and update the second list box. Here is an example of this. I am 
only doing the hook one way so scrolling listbox2 won't scroll listbox1.

You will need to add this TListBox override to your unit before the form declaration:

TListBox = class(Vcl.StdCtrls.TListBox)
private
  FOnScroll: TNotifyEvent;
protected
  procedure ListBoxScroll(var Message: TMessage); message WM_VSCROLL;
public
  property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
end;

This adds a OnScroll event to the listbox. The implementation for this class:

procedure TListBox.ListBoxScroll(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnScroll) then
    FOnScroll(Self);
end;

You can then hook up the event in code:

procedure TMyForm.FormCreate(Sender: TObject);
begin
  listbox1.OnScroll := DoScrollListBox1;
end;

The code for DoScrollListBox1 is very simple:

procedure TMyForm.DoScrollListBox1(Sender: TObject);
begin
  listbox2.TopIndex := listbox1.TopIndex;
end;

This handles the scrolling by using the scroll bar. You will also need to add the following line
to your OnClick of the listbox so keyboard actions will also trigger the scrolling.

procedure TMyForm.ListBox1Click(Sender: TObject);
begin
  ...
  listbox2.TopIndex := listbox1.TopIndex; 
  ...
end;

My modified version of the above code: 

 

unit Unit1;

interface

  TForm1 = class(TForm)
    memo1: TMemo;
    memo2: TMemo;
    procedure memo1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

{$R *.dfm}

procedure TMemo.MemoScroll(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnScroll) then
    FOnScroll(Self);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.OnScroll := DoScrollMemo;
end;
procedure tform1.DoScrollMemo(Sender: TObject);
begin
  memo2.TopIndex := memo1.TopIndex;
end;

// This handles the scrolling by using the scroll bar. You will also need to
// add the following line to your OnClick of the listbox so keyboard actions
// will also trigger the scrolling.
procedure tform1.memo1Click(Sender: TObject);
begin
  //...
  //memo2.TopIndex := memo1.TopIndex; // <--- Does not compile at this point because there is no .TopIndex in TMemo. I learned this all to late. 
  //...
end;

Does anyone have source code for synchronizing two TMemo's?

 

Edited March 1 by JohnLM
typo at end

[Uwe Raabe 2127]

It depends a bit what the exact use case is, but it probably can be achieved with a class derived from TMemo with the following extensions:

type
  TLinkMemo = class(TMemo)
  private
    FLinkedMemo: TLinkMemo;
    procedure WMVScroll(var Message: TMessage); message WM_VSCROLL;
    procedure DoScroll(var Message: TMessage);
  public
    property LinkedMemo: TLinkMemo read FLinkedMemo write FLinkedMemo;
  end;

procedure TLinkMemo.DoScroll(var Message: TMessage);
begin
  var saveLinkedMemo := FLinkedMemo;
  try
    FLinkedMemo := nil;
    Perform(Message.Msg, Message.WParam, Message.LParam);
  finally
    FLinkedMemo := saveLinkedMemo;
  end;
end;

procedure TLinkMemo.WMVScroll(var Message: TMessage);
begin
  inherited;
  if FLinkedMemo <> nil then
    FLinkedMemo.DoScroll(Message);
end;

In FormCreate you just assign both LinkedMemo properties:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.LinkedMemo := Memo2;
  Memo2.LinkedMemo := Memo1;
end;

To avoid having to register this new control TLinkMemo you can use an interposer class declared before the form, either in the same unit or in a separate unit used in the interface uses clause.

type
  TMemo = class(TLinkMemo);

Note, that editing one of the memo will break sync between the controls.

Edited February 28 by Uwe Raabe

[JohnLM 27]

I am marking this as Solved !!

 

I can't tell you how many, many months I spent searching on/off these last two years and probably further back, for this solution!  And I'm sure there are others out there in this boat. 

 

Thank you Uwe, for this code snippet!   It works well.  Even the PageDn/PageUp keys scync as well.   

 

And yes, the data in the two memo's will not change.  I am reading large data comparisons, and puzzles that I bump/parse/etc..  And not having to add line numbers (if I don't have to, in order to sync what I am reading) is a plus, thus one less step to do. 

[limelect 51]

Great but out of curiosity I added

    procedure WMVScroll(var Message: TMessage); message WM_VSCROLL;
    procedure WMHScroll(var Message: TMessage); message WM_HSCROLL;

 

@JohnLM But not with arrow up or down

Edited March 6 by limelect

[JohnLM 27]

Unfortunately, no.  As it turns out, I do need to cursor-Up/Down when inside any of the memos.  I have been searching all around to figure this one out, but to no avail.  However, I have one clue that should work that (I believe) is required to make the scrolling up/down part to work: 

 

1. when inside the memo cursoring up/down, calculate the inside of the memo window, the top or bottom (depending on your cursor/caret position)

2. use that to set the scrolling position (for both memos)

3. then, find the scrollbar up/down chicklet and tap it.  That should trigger the scrolling up/down.  I'm sure of it. 

 

But I can't figure out how to calculate the inside memo area, and I can't figure out how to find the scrollbar of the current memo that I am in to move the mouse pointer to it to tap it.

 

I'm sure there is more than one way to accomplish this, but the above is my non-advanced way. 

 

But I have at least one clue, LoL.  I found this code a few days ago.  I just been busy and out of energy in this endeavor to continue it yet.  Once I find that link in one of my browsers, I will post it. Maybe you can continue that part in step 1 for me, and maybe step 3 if you know that already. 

 

 

[JohnLM 27]

Okay, I found the link. It is to calculate the memo's lines, or I believe it to be part of what I was searching for. Its old, from 2013 but still useful, I believe. 

 

https://stackoverflow.com/questions/17707689/delphi-scrolling-memo

 

see Sertac Akyuz's response where he posted some code, the first part. He explains it better than I what is needed.  

 

As for step 3, so far, I have not found a way. 
 

[JohnLM 27]

I felt I better try to explain my idea, regarding being inside the memo and cursoring up or down and cusing both memos to scroll in sync: 

 

When you are inside the memo and, say, cursor keying down, you want to find the last line that is with-in the memo's window region.  So say you have 30 lines of text in the main memo (the left pane) and your window's dimentional region is showing 5 lines of text: 

(mind you, both memo's have the exact text)

 

1

2

3

=========================================

4 this is line 4, I am 4 lines into this memo of 30 total lines. 

5 and line 5, okay getting somewhere

6 line 6, getting closer

7 line 7, almost there

8 line 8, I'm here, at the end section of the region, now i want to see lines 9 and onward in this memo and cause the other memo to scroll in sync.

=========================================

9

10

.

.

30 end of memo document. 

 

You don't want the cursor down key to cause a (down) scrolling to occur while inside that window between line 4 and 7 as you are cursor down'ing, but when you are at line 8 and you press the cursor down key, then you want the scrolling(s) to occur in sync.  And the same goes for when you are cursoring up, to not (up) scrolling in sync until you are at 4 and want to scroll into line 3 and so on until you hit line 1 and no scrolling should occur. 

 

Edited March 6 by JohnLM
typos

[JohnLM 27]

update on the sync'ed scrolling of both memos via the cursor UP and DOWN keys when inside a memo. . . 

 

using the code from the link I posted earlier, I have the following working to scroll the memo's during cursor up/down inside a memo.  I am calling the methods from memo1 only, not added to memo2 for this test demo. 

 

To make things a little convenient, below is a short demo project.   

 

1. add two memos controls to a form. (I called mine m1 and m1 to reduce typing).

2. add two statictext controls. (again, I called mine st1 and st2) - I was using them to help me debug where I was at in the memo via the memo.caret.Y position.

3. fill both memos with some text. I added the following in both memos to make things easier, below. 

 

1 line 1
2 line 2
3 line 3
4 line 4
5 line 5
6 line 6
7 line 7
8 line 8
9 line 9
10 line 10
11 line 11
12 line 12

The source code so far. . . 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    m1: TMemo;
    m2: TMemo;
    Splitter1: TSplitter;
    st1: TStaticText;
    st2: TStaticText;
    procedure m1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetVisibleLineCount(Memo: TMemo): Integer;
var
  DC: HDC;
  SaveFont: HFONT;
  TextMetric: TTextMetric;
  EditRect: TRect;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Memo.Font.Handle);
  GetTextMetrics(DC, TextMetric);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Memo.Perform(EM_GETRECT, 0, LPARAM(@EditRect));
  Result := (EditRect.Bottom - EditRect.Top) div TextMetric.tmHeight;
  form1.st1.Caption := result.ToString();
end;

procedure TForm1.m1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  LineCount, TopLine: Integer;
begin
  // sec 1
  if key=vk_down then begin
    st2.Caption := m1.CaretPos.Y.ToString();
    LineCount := M1.Perform(EM_GETLINECOUNT, 0, 0) - 1;
    TopLine   := M1.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
    if (m1.CaretPos.Y+topline >= GetVisibleLineCount(M1)) then begin
      SendMessage(M2.Handle, EM_LINESCROLL, 0, 1);
    end;
  end;

  // sec 2
  if key=vk_up then begin
    st2.Caption := m1.CaretPos.Y.ToString();
    LineCount := M1.Perform(EM_GETLINECOUNT, 0, 0) - 1;
    TopLine   := M1.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
    if (m1.CaretPos.Y <= GetVisibleLineCount(M1)) then begin
      SendMessage(M2.Handle, EM_LINESCROLL, 0, -1);
    end;
  end;
end;

end.

When you run it, and cursor down, when you are on line 8, and cursor down, the second memo will scroll. 

 

But, when cursor'ing up, its buggy. I can't seem to figure how to sync the two as yet in { // sec 2 } its just eluding me at the moment, and its late and I'm in a rush to get ready for work. 

 

Note, it is not as fluidly smooth/quick as the part that Uwe had posted earlier, but it should get the job done once the bug(s) are resolved. 

 

I gave it a shot, but perhaps someone else reading this can figure it out or something else better. 

 

visual screenshot demo from design mode, below. 

 

 

Edited March 6 by JohnLM
typos

[Uwe Raabe 2127]

I can provide an alternative solution:

type
  TLinkMemo = class(TMemo)
  private
    FLinkedMemo: TLinkMemo;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure WMVScroll(var Message: TMessage); message WM_VSCROLL;
    procedure SyncLink;
  public
    property LinkedMemo: TLinkMemo read FLinkedMemo write FLinkedMemo;
  end;

procedure TLinkMemo.CNCommand(var Message: TWMCommand);
begin
  inherited;
  if Message.NotifyCode = EN_VSCROLL then
    SyncLink;
end;

procedure TLinkMemo.SyncLink;
begin
  if LinkedMemo = nil then Exit;

  var myFirstLine := Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
  var linkFirstLine := LinkedMemo.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);

  if myFirstLine = linkFirstLine then Exit;

  LinkedMemo.Perform(EM_LINESCROLL, 0, myFirstLine - linkFirstLine);
end;

procedure TLinkMemo.WMVScroll(var Message: TMessage);
begin
  inherited;
  SyncLink;
end;

 

[limelect 51]

@Uwe Raabe

Tested and up and down keys work but not the left and right or HOME and END keys to be perfect

D10.2.3

MemoScrol.zip

Edited March 7 by limelect

[limelect 51]

I have added 

  if Message.NotifyCode = (EN_VSCROLL {or EN_HSCROLL}) then
    SyncLink;
if Message.NotifyCode =  EN_HSCROLL then
    SyncLink;
OR did not work but still does not work

I guess we need to catch the line character  position too

TLinkMemo.SyncLink has to deal with line change and character position

Edited March 7 by limelect

[Uwe Raabe 2127]

OK, next iteration:

type
  TLinkMemo = class(TMemo)
  private
    FLinkedMemo: TLinkMemo;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure WMHScroll(var Message: TMessage); message WM_HSCROLL;
    procedure WMVScroll(var Message: TMessage); message WM_VSCROLL;
    procedure SyncLink;
  public
    property LinkedMemo: TLinkMemo read FLinkedMemo write FLinkedMemo;
  end;

procedure TLinkMemo.CNCommand(var Message: TWMCommand);
begin
  inherited;
  if (Message.NotifyCode = EN_VSCROLL) or (Message.NotifyCode = EN_HSCROLL) then
    SyncLink;
end;

procedure TLinkMemo.SyncLink;
begin
  if LinkedMemo = nil then Exit;

  var saveLink := LinkedMemo;
  try
    LinkedMemo := nil;

    saveLink.CaretPos := CaretPos;
    saveLink.Perform(EM_SCROLLCARET, 0, 0);

    var myLine := Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
    var linkLine := saveLink.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
    if myLine = linkLine then Exit;

    saveLink.Perform(EM_LINESCROLL, 0, myLine - linkLine);
  finally
    LinkedMemo := saveLink;
  end;
end;

procedure TLinkMemo.WMHScroll(var Message: TMessage);
begin
  inherited;
  SyncLink;
end;

procedure TLinkMemo.WMVScroll(var Message: TMessage);
begin
  inherited;
  SyncLink;
end;

 

[dwrbudr 8]

If still not working, I have a solution for synchronizing two tree views that I could post.
The difference is that I override the tree WndProc and process those messages:
WM_VSCROLL, WM_NCLBUTTONUP, WM_KEYDOWN, WM_LBUTTONUP, WM_MOUSEWHEEL

[limelect 51]

 

With the above new software, I succeeded in doing the above screen

The older version (my zip ?) worked better

[limelect 51]

Ok guys this zip tested On all keys

Home, end, arrow up down left and right, scroll up scroll down, and left and right

ALL WORK But 

Someone fix the Page up or down

I mixed the 2 versions and now lastly needed to fix the above

I think it would be nice if the cursor position were shown on both memos

MemoScrol.zip

Edited March 8 by limelect

[limelect 51]

Ok all keys work

1. While using the page up or down there was a need to disable

   DoScroll . while using SyncLink do not use DoScroll

2. I had to add    saveLink.Perform(EM_SETSEL, 0, myLine - linkLine);

  otherwise, the page up or down was not synchronized and text was not shown correctly

I hope I did a good job while enjoying to play with it

 

Who said he wants to move to AI. So let AI do this job

P.S. Mouse weel dose not work on this program.

If anyone wants to keep playing with this I finished

 

MemoScrol.zip

Edited March 9 by limelect

[Kryvich 174]

@limelect I guess you've over-engineered it a bit. @Uwe Raabe gave a great variant, it just needs a bit of tweaking.

 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TLinkMemo = class(TMemo)
  private
    FLinkedMemo: TLinkMemo;
    procedure WMVScroll(var Message: TMessage); message WM_VSCROLL;
    procedure WMHScroll(var Message: TMessage); message WM_HSCROLL;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure SyncLink;
  public
    property LinkedMemo: TLinkMemo read FLinkedMemo write FLinkedMemo;
  end;

  TMemo = class(TLinkMemo);

  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TLinkMemo.SyncLink;
var
  savedLink: TLinkMemo;
  myLine, linkLine: Integer;
begin
  if LinkedMemo = nil then
    Exit;
  savedLink := LinkedMemo.LinkedMemo;
  try
    LinkedMemo.LinkedMemo := nil;
    LinkedMemo.CaretPos := CaretPos;
    LinkedMemo.Perform(EM_SCROLLCARET, 0, 0);
    myLine := Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
    linkLine := LinkedMemo.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
    if myLine <> linkLine then
      LinkedMemo.Perform(EM_LINESCROLL, 0, myLine - linkLine);
  finally
    LinkedMemo.LinkedMemo := savedLink;
  end;
end;

procedure TLinkMemo.CNCommand(var Message: TWMCommand);
begin
  inherited;
  if (Message.NotifyCode = EN_VSCROLL)
    or (Message.NotifyCode = EN_HSCROLL)
  then
    SyncLink;
end;

procedure TLinkMemo.WMVScroll(var Message: TMessage);
begin
  inherited;
  SyncLink;
end;

procedure TLinkMemo.WMHScroll(var Message: TMessage);
begin
  inherited;
  SyncLink;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.LinkedMemo := Memo2;
  Memo2.LinkedMemo := Memo1;
end;

end.

 

Edited March 10 by Kryvich

[limelect 51]

@Kryvich  Sorry Back to the drawing board. The Horizontal move does not work

 

It seems to be a better solution  fix the horizontal move

Mouse wheel workers too

 

I am a good debugger at list

Edited March 10 by limelect

[Uwe Raabe 2127]

Horizontal scrolling can be made to work, but doing that with the mouse wheel always produces glitches. I guess, it is because the scrolling is done with pixels, while EM_LINESCROLL does it with characters.

 

type
  TLinkMemo = class(TMemo)
  private
    FLinkedMemo: TLinkMemo;
    FSkipScroll: Boolean;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure WMHScroll(var Message: TMessage); message WM_HSCROLL;
    procedure WMVScroll(var Message: TMessage); message WM_VSCROLL;
    procedure SyncLink;
    procedure DoScroll(var Message: TMessage);
  public
    property LinkedMemo: TLinkMemo read FLinkedMemo write FLinkedMemo;
  end;

procedure TLinkMemo.CNCommand(var Message: TWMCommand);
begin
  inherited;
  FSkipScroll := False;
  if (Message.NotifyCode = EN_VSCROLL) or (Message.NotifyCode = EN_HSCROLL) then begin
    SyncLink;
    FSkipScroll := True;
  end;
end;

procedure TLinkMemo.DoScroll(var Message: TMessage);
begin
  var saveLinkedMemo := FLinkedMemo;
  try
    FLinkedMemo := nil;
    Perform(Message.Msg, Message.WParam, Message.LParam);
  finally
    FLinkedMemo := saveLinkedMemo;
  end;
end;

procedure TLinkMemo.SyncLink;
begin
  if LinkedMemo = nil then Exit;

  var saveLink := LinkedMemo.LinkedMemo;
  try
    LinkedMemo.LinkedMemo := nil;

    var myFirstVisibleChar := Perform(EM_CHARFROMPOS, 0, 0);
    var linkFirstVisibleChar := LinkedMemo.Perform(EM_CHARFROMPOS, 0, 0);
    if myFirstVisibleChar = linkFirstVisibleChar then Exit;

    var myLineIndex := Perform(EM_LINEFROMCHAR, myFirstVisibleChar, 0);
    var myLineStart := Perform(EM_LINEINDEX, myLineIndex, 0);
    var myCharIndex := myFirstVisibleChar - myLineStart;

    var linkLineIndex := LinkedMemo.Perform(EM_LINEFROMCHAR, linkFirstVisibleChar, 0);
    var linkLineStart := LinkedMemo.Perform(EM_LINEINDEX, linkLineIndex, 0);
    var linkCharIndex := linkFirstVisibleChar - linkLineStart;

    LinkedMemo.CaretPos := CaretPos;
    if myCharIndex < linkCharIndex then begin
      LinkedMemo.CaretPos := TPoint.Create(0, myLineIndex);
      LinkedMemo.Perform(EM_SCROLLCARET, 0, 0);
      LinkedMemo.CaretPos := CaretPos;
      linkCharIndex := 0;
    end;
    LinkedMemo.Perform(EM_LINESCROLL, myCharIndex - linkCharIndex, myLineIndex - linkLineIndex);
  finally
    LinkedMemo.LinkedMemo := saveLink;
  end;
end;

procedure TLinkMemo.WMHScroll(var Message: TMessage);
begin
  inherited;
  if FSkipScroll then begin
    FSkipScroll := False;
    Exit;
  end;

  if LinkedMemo <> nil then
    LinkedMemo.DoScroll(Message);
end;

procedure TLinkMemo.WMVScroll(var Message: TMessage);
begin
  inherited;
  if FSkipScroll then begin
    FSkipScroll := False;
    Exit;
  end;

  if LinkedMemo <> nil then
    LinkedMemo.DoScroll(Message);
end;

 

[limelect 51]

@Uwe Raabe

In my case I tried to add

procedure WndProc(var Message: TMessage);message WM_MOUSEWHEEL;

 

procedure TLinkMemo.WndProc(var Message: TMessage);
var
i:Integer;

begin
 inherited;
    if Message.Msg=WM_MOUSEWHEEL then begin
    begin
    disable2:=True;
   SyncLink(true,TWMMouseWheel(Message).Pos);

    end;
 //  i:=  TWMMouseWheel(Message).WheelDelta;
   end

end;

 

and disable carpos in SyncLink;

if disable2 then

    saveLink.CaretPos := p<< came from mouse wheel
    else
    saveLink.CaretPos := CaretPos;

calling

SyncLink(true,TWMMouseWheel(Message).Pos);

 

but I found out that SyncLink; came before the mouse wheel (because of CNCommand)

I tried to detect if the mouse wheel inside SyncLink;

but could not.

[Kryvich 174]

OK, my take.

 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TLinkMemo = class(TMemo)
  private
    FLinkedMemo: TLinkMemo;
    procedure SyncLink;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    property LinkedMemo: TLinkMemo read FLinkedMemo write FLinkedMemo;
  end;

  TMemo = class(TLinkMemo);

  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TLinkMemo.WndProc(var Message: TMessage);
begin
  inherited;
  if (LinkedMemo = nil)
    or not LinkedMemo.HandleAllocated
  then
    Exit;
  case Message.Msg of
    WM_HSCROLL, WM_VSCROLL, WM_KEYDOWN, WM_MOUSEFIRST..WM_MOUSELAST: SyncLink;
  end;
end;

procedure TLinkMemo.SyncLink;

  procedure UpdateScrollBar(BarFlag: Integer; Msg: Cardinal);
  var
    scrollInfo: TScrollInfo;
  begin
    scrollInfo.cbSize := SizeOf(scrollInfo);
    scrollInfo.fMask  := SIF_POS;
    if GetScrollInfo(Handle, BarFlag, scrollInfo) then
      LinkedMemo.Perform(Msg, MAKEWPARAM(SB_THUMBPOSITION, scrollInfo.nPos), 0);
  end;

var
  savedLink: TLinkMemo;
begin
  savedLink := LinkedMemo.LinkedMemo;
  try
    LinkedMemo.LinkedMemo := nil;
    UpdateScrollBar(SB_HORZ, WM_HSCROLL);
    UpdateScrollBar(SB_VERT, WM_VSCROLL);
  finally
    LinkedMemo.LinkedMemo := savedLink;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.LinkedMemo := Memo2;
  Memo2.LinkedMemo := Memo1;
end;

end.

 

Edited March 10 by Kryvich

[limelect 51]

@Kryvich Still no horizontal

[Kryvich 174]

@limelect It's strange. Works fine for me on Windows 10. (Screencast attached).

 

[limelect 51]

Window 7.

With my Zip it works OK

[Kryvich 174]

OK I checked my code on Windows 7 in VirtualBox. Works like a charm.