在表单上任意位置滑动鼠标滚轮来使表单上下滚动

*!*     作者：十豆三
*!*     日期：2011-12-03
*!*  vfp版本：vfp9.0(SP2 7423)
*!* 操作系统：Windows XP(SP3)

*-- 前提：表单具有滚动条，即表单 ScrollBars 属性为 2 或 3
*-- 为了测试，在表单添加了多种控件
*-- 主要代码在自定义方法 mymousewheel、setmousewheel 和 Init 事件中。

Public oform1
oform1=Newobject("form1")
oform1.Show
Return

Define Class form1 As Form

Top = 0
Left = 0
Height = 342
Width = 420
ScrollBars = 3
DoCreate = .T.
Caption = "Form1"
KeyPreview = .T.
WindowState = 0
ContinuousScroll = .F.
Name = "Form1"

Add Object command1 As CommandButton With;
    Top = 312, ;
    Left = 384, ;
   Height = 25, ;
   Width = 60, ;
   Caption = "Command1", ;
   Name = "Command1"
 

Add Object text1 As TextBox With ;
    Height = 20, ;
    Left = 432, ;
   Top = 336, ;
   Width = 100, ;
   Name = "Text1"
 

Add Object label1 As Label With ;
   Caption = "Label1", ;
   Height = 16, ;
   Left = 516, ;
   Top = 384, ;
   Width = 38, ;
   Name = "Label1"
 

Add Object command2 As CommandButton With ;
    Top = 12, ;
   Left = 336, ;
   Height = 25, ;
   Width = 60, ;
   Caption = "Command2", ;
   Name = "Command2"
 

Add Object grid1 As Grid With ;
    Height = 116, ;
    Left = 216, ;
    Top = 48, ;
    Width = 176, ;
   Name = "Grid1"
 

Add Object shape1 As Shape With ;
    Top = 0, ;
    Left = 12, ;
    Height = 372, ;
    Width = 109, ;
    Name = "Shape1"
 

Add Object command3 As CommandButton With ;
    Top = 120, ;
    Left = 144, ;
    Height = 25, ;
    Width = 60, ;
    Caption = "Command3", ;
    Name = "Command3"
 

Add Object container1 As Container With ;
    Top = 192, ;
    Left = 156, ;
    Width = 156, ;
    Height = 116, ;
    Name = "Container1"

Procedure container1.Init
   This.AddObject('Pageframe1','Pageframe')
    This.Pageframe1.Move(24,12,121,85)
    This.Pageframe1.PageCount=2
    This.Pageframe1.page1.AddObject('Command1','CommandButton')
    This.Pageframe1.page1.Command1.Move(23,22,60,25)
    This.Pageframe1.Visible=.T.
    This.Pageframe1.page1.Command1.Visible=.T.
Endproc
 

Procedure mymousewheel
    Lparameters nDirection, nShift, nXCoord, nYCoord
    Thisform.SetViewPort(Thisform.ViewPortLeft,Max(Thisform.ViewPortTop-Iif(nDirection>0,1,-1),0))
    Nodefault && 鼠标在 表格、容器、页框中滚动均有效果，但当鼠标焦点在 表格 中时，会同时触发 表格 的滚动事件，所以要加此句来不执行原默认事件。
Endproc
 

Procedure setmousewheel
    Lparameters toControl
    If Pemstatus(toControl,"MouseWheel",5)
       =Bindevent(toControl,"MouseWheel",This,"MyMouseWheel")
    Endif
   If Type("toControl.Objects[1]")="O"
        Local loI
        For Each loI IntoControl.Objects
           This.SetMouseWheel(loI)
        Endfor
   Endif
Endproc
 

Procedure Init
   This.ScaleMode=0
    This.SetMouseWheel(Thisform)
Endproc
 

Procedure Load
   Create Cursor t1 (a1 i)
    For lnI=1 To 20
        Insert Into t1 Values (lnI)
    Endfor
   Locate
Endproc

Enddefine