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