Мой DELPHI – Программирование

Вопрос:
Как перехватить сообщения прокрутки в TScrollBox?
Ответ:
Следующий пример перехватывает сообщения о прокрутке компонента TScrollBox и
синхронизирует обе линейки прокрутки. Сообщения прокрутки перехватываются с помощью
переопределения окнной процедуры (WinProc) ScrollBox'а.

Пример:

type
{$IFDEF WIN32}
	WParameter = LongInt;
{$ELSE}
	WParameter = Word;
{$ENDIF}
	LParameter = LongInt;

{Declare a variable to hold the window procedure we are replacing}
var
	OldWindowProc : Pointer;

function NewWindowProc(WindowHandle : hWnd;
	TheMessage   : WParameter;
	ParamW : WParameter;
	ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
var
	TheRangeMin : integer;
	TheRangeMax : integer;
	TheRange : integer;
begin
	if TheMessage = WM_VSCROLL then
	begin
		{Get the min and max range of the horizontal scroll box}
		GetScrollRange(WindowHandle, SB_HORZ, TheRangeMin, TheRangeMax);
		{Get the vertical scroll box position}
		TheRange := GetScrollPos(WindowHandle, SB_VERT);
		{Make sure we wont exceed the range}
		if TheRange < TheRangeMin then
		TheRange := TheRangeMin else
		if TheRange > TheRangeMax then
		TheRange := TheRangeMax;
		{Set the horizontal scroll bar}
		SetScrollPos(WindowHandle, SB_HORZ, TheRange, true);
	end;
	if TheMessage = WM_HSCROLL then
	begin
		{Get the min and max range of the horizontal scroll box}
		GetScrollRange(WindowHandle, SB_VERT, heRangeMin, TheRangeMax);
		{Get the horizontal scroll box position}
		TheRange := GetScrollPos(WindowHandle, SB_HORZ);
		{Make sure we wont exceed the range}
		if TheRange < TheRangeMin then
			TheRange := TheRangeMin
		else
			if TheRange > TheRangeMax then
				TheRange := TheRangeMax;
			{Set the vertical scroll bar}
			SetScrollPos(WindowHandle, SB_VERT, TheRange, true);
	end;

	{Call the old Window procedure to allow processing of the message.}
	NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage,
					ParamW, ParamL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
	{Set the new window procedure for the control and remember
				the old window procedure.}
	OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC,
				LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
	{Set the window procedure back to the old window procedure.}
	SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;