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

*!* 作者：十豆三

*!* 日期：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