Читать «Виртуальная библиотека Delphi» онлайн - страница 173

 MemHandle := LoadResource(hInstance, ResHandle);

 ResPtr := LockResource(MemHandle);

 MemStream := TMemoryStream.Create;

 JPEGImage := TJPEGImage.Create;

 ResSize := SizeOfResource(hInstance, ResHandle);

 MemStream.SetSize(ResSize);

 MemStream.Write(ResPtr^, ResSize);

 FreeResource(MemHandle);

 MemStream.Seek(0, 0);

 JPEGImage.LoadFromStream(MemStream);

 ThePicture.Assign(JPEGImage);

 JPEGImage.Free;

 MemStream.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 LoadJPEGFromRes('MYJPEG', Image1.Picture);

end;

Вопрос:

Как перехватить сообщения прокрутки в 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