Главная страница | назад





Article #15942: Trap scrolling messages for the ScrollBars of a TScrollBox

 Question and Answer Database

FAQ942D.txt   Trap scrolling messages for the ScrollBars of a TScrollBox
Category   :VCL
Platform    :All
Product    :All 32 bit  

Question:
How can I trap the scrolling messages for the ScrollBars of a
TScrollBox component?

Answer:
The following example traps the scrolling messages for a
TScrollBox component, keeping the two scroll bars in sync. If either
of the scroll bars are scrolled, then the position of the other scroll
bar is changed to the same value. The scroll messages are trapped by
subclassing the scroll box's WinProc.


Example:

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,
                   TheRangeMin,
                   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;

7/16/98 4:31:28 PM
 

Last Modified: 01-SEP-99