如何使用两个列表框(Tlistbox)的条目同步滚动(100分)

如何使用两个列表框(Tlistbox)的条目同步滚动
有两个列表框Listbox1,Listbox2，它们的items.count相等，如何编程使之实现下面的功能：
1、相滚动Listbox1的条目时，要求Listbox2同步滚动
2、相滚动Listbox2的条目时，要求Listbox1同步滚动
3、在同步滚动时，不改变Listbox1,Listbox2已经挑选的条目(items)

up

gz

use SendMessage

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FOldListBox1Proc, FOldListBox2Proc : TWndMethod;
procedure MyListBox1Proc(var Message:TMessage);
procedure MyListBox2Proc(var Message:TMessage);
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.MyListBox1Proc(var Message: TMessage);
begin
if message.Msg = WM_VSCROLL then
begin
ListBox2.TopIndex := ListBox1.TopIndex;
end;
FOldListBox1Proc(message);
end;

procedure TForm1.MyListBox2Proc(var Message: TMessage);
begin
if message.Msg = WM_VSCROLL then
begin
ListBox1.TopIndex := ListBox2.TopIndex;
end;
FOldListBox2Proc(message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FOldListBox1Proc := Listbox1.WindowProc;
ListBox1.WindowProc := MyListBox1Proc;
FOldListBox2Proc := Listbox2.WindowProc;
ListBox2.WindowProc := MyListBox2Proc;
end;

end.

谢谢zw84611
您的程序基本满足要求，但是有缺点
1.当用鼠标的滚轮滚动Listbox1的条目时，Listbox2的条目不变。
2.当用光标移动Listbox1的条目时，Listbox2的条目不变。

下面是我改装的程序，原理好象与zw84611差不多，但是为什么我的程序会出错？

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
ListBox2: TListBox;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FOldProc : TWndMethod;
FOldProc2 : TWndMethod;
procedure MyProc(var Message:TMessage);
procedure MyProc2(var Message:TMessage);

public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
{ TForm1 }
procedure TForm1.MyProc(var Message: TMessage);
begin
if message.Msg = WM_VSCROLL then
begin
SendMessage(Listbox2.Handle,Message.Msg,Message.WParam,Message.LParam);
end;
FOldProc(message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FOldProc := Listbox1.WindowProc;
ListBox1.WindowProc := MyProc;
FOldProc2 := Listbox2.WindowProc;
ListBox2.WindowProc := MyProc2;
end;

procedure TForm1.MyProc2(var Message: TMessage);
begin
if message.Msg = WM_VSCROLL then
begin
SendMessage(Listbox1.Handle,Message.Msg,Message.WParam,Message.LParam);
end;
FOldProc2(message);
end;

end.

相互发送消息，没完没了，程序会死掉吧！

多人接受答案了。