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.