捕获滚动框中的滚动条的滚动消息

http://www.codesky.net/article/200308/940.html

捕获滚动框中的滚动条的滚动消息

阅读：1136次   时间：2003-08-15 00:00:00   字体：[大 中 小]

    下面的例子捕获滚动框的滚动消息,保持两个滚动条同步。如果任意一滚动条滚动,其他的滚动条也以相同的值滚动。滚动框的窗体函数捕获滚动消息。

    例子: 

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

{声明一个变量来保存被替代的窗体函数} 
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 
  {取得滚动框的水平滚动范围} 
    GetScrollRange(WindowHandle, 
                   SB_HORZ, 
                   TheRangeMin, 
                   TheRangeMax); 
  {取得滚动框的垂直滚动位置} 
    TheRange := GetScrollPos(WindowHandle, 
                             SB_VERT); 
  {保证不超过滚动范围} 
    if TheRange < TheRangeMin then 
      TheRange := TheRangeMin else 
    if TheRange > TheRangeMax then 
      TheRange := TheRangeMax; 
  {设置水平滚动条} 
    SetScrollPos(WindowHandle, 
                 SB_HORZ, 
                 TheRange, 
                 true); 
  end; 

  if TheMessage = WM_HSCROLL then begin 
  {取得滚动框的垂直滚动范围} 
    GetScrollRange(WindowHandle, 
                   SB_VERT, 
                   TheRangeMin, 
                   TheRangeMax); 
  {取得滚动框的水平滚动位置} 
    TheRange := GetScrollPos(WindowHandle, 
                             SB_HORZ); 
  {保证不超过滚动范围} 
    if TheRange < TheRangeMin then 
      TheRange := TheRangeMin else 
    if TheRange > TheRangeMax then 
      TheRange := TheRangeMax; 
  {设置垂直滚动条} 
    SetScrollPos(WindowHandle, 
                 SB_VERT, 
                 TheRange, 
                 true); 
  end; 

{ 调用原来的窗体函数 } 
{ 允许消息处理 } 
  NewWindowProc := CallWindowProc(OldWindowProc, 
                                  WindowHandle, 
                                  TheMessage, 
                                  ParamW, 
                                  ParamL); 
end; 


procedure TForm1.FormCreate(Sender: TObject); 
begin 
{ 为控件设置新的窗体函数 } 
{ 并保存旧的窗体函数     } 
  OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, 
                                         GWL_WNDPROC, 
                                         LongInt(@NewWindowProc))); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
{ 恢复原来的窗体函数  } 
  SetWindowLong(ScrollBox1.Handle, 
                GWL_WNDPROC, 
                LongInt(OldWindowProc)); 

end;