Memos synchron scrollen

[Muellermilchtrinker]

Das wär die ganze Unit:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private-Deklarationen }
    PRichEdWndProc, POldWndProc: Pointer;
    PRichEdWndProc2, POldWndProc2: Pointer;
    procedure RichEdWndProc(var Msg: TMessage);
    procedure RichEdWndProc2(var Msg: TMessage);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  PRichEdWndProc := MakeObjectInstance(RichEdWndProc);
  POldWndProc    := Pointer(SetWindowLong(Memo1.Handle, GWL_WNDPROC,
    Integer(PRichEdWndProc)));
  PRichEdWndProc2 := MakeObjectInstance(RichEdWndProc);
  POldWndProc2    := Pointer(SetWindowLong(Memo2.Handle, GWL_WNDPROC,
    Integer(PRichEdWndProc2)));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(PRichEdWndProc) then
  begin
    SetWindowLong(Memo1.Handle, GWL_WNDPROC, Integer(POldWndProc));
    FreeObjectInstance(PRichEdWndProc);
  end;
  if Assigned(PRichEdWndProc2) then
  begin
    SetWindowLong(Memo2.Handle, GWL_WNDPROC, Integer(POldWndProc));
    FreeObjectInstance(PRichEdWndProc2);
  end;
end;


procedure TForm1.RichEdWndProc(var Msg: TMessage);
begin
  Msg.Result := CallWindowProc(POldWndProc, Memo1.Handle, Msg.Msg,
    Msg.wParam, Msg.lParam);

  if (Msg.Msg = WM_VSCROLL) and (LOWORD(Msg.wParam) = SB_THUMBTRACK) then
  begin
    Memo2.Perform(Msg.Msg, Msg.wParam, Msg.lParam);
    SetScrollPos(Memo2.Handle, SB_VERT, HIWORD(Msg.wParam), True);
  end;
end;

procedure TForm1.RichEdWndProc2(var Msg: TMessage);
begin
  Msg.Result := CallWindowProc(POldWndProc, Memo2.Handle, Msg.Msg,
    Msg.wParam, Msg.lParam);

  if (Msg.Msg = WM_VSCROLL) and (LOWORD(Msg.wParam) = SB_THUMBTRACK) then
  begin
    Memo2.Perform(Msg.Msg, Msg.wParam, Msg.lParam);
    SetScrollPos(Memo1.Handle, SB_VERT, HIWORD(Msg.wParam), True);
  end;
end;

end.