精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● VFP>>〖源码共赏〗>>水平滚动条

主题:水平滚动条
发信人: lawskin(law)
整理人: foxzz(2004-12-28 08:53:32), 站内信件

**************************************************
*-- Class:        hscrollbar (f:\winson8\myclass.vcx)
*-- ParentClass:  container
*-- BaseClass:    container
*-- Time Stamp:   11/06/04 02:40:06 PM
*
DEFINE CLASS hscrollbar AS container


Width = 273
Height = 16
BorderWidth = 0
BackColor = RGB(230,230,230)
scrollobject = ""
HIDDEN barrotate
barrotate = 0
HIDDEN ratio
ratio = 0
Name = "hscrollbar"


ADD OBJECT ctnbar AS container WITH ;
Top = 0, ;
Left = 18, ;
Width = 132, ;
Height = 15, ;
SpecialEffect = 0, ;
Name = "ctnBar"


ADD OBJECT ctnleft AS container WITH ;
Top = 0, ;
Left = 0, ;
Width = 16, ;
Height = 15, ;
BorderWidth = 0, ;
Name = "ctnleft"


ADD OBJECT hscrollbar.ctnleft.lintop AS line WITH ;
Height = 0, ;
Left = 0, ;
Top = 0, ;
Width = 16, ;
BorderColor = RGB(255,255,255), ;
Name = "lintop"


ADD OBJECT hscrollbar.ctnleft.linleft AS line WITH ;
Height = 16, ;
Left = 0, ;
Top = -1, ;
Width = 0, ;
BorderColor = RGB(255,255,255), ;
Name = "linleft"


ADD OBJECT hscrollbar.ctnleft.linbot1 AS line WITH ;
Height = 0, ;
Left = 0, ;
Top = 14, ;
Width = 15, ;
Name = "linbot1"


ADD OBJECT hscrollbar.ctnleft.linright1 AS line WITH ;
Height = 15, ;
Left = 15, ;
Top = 0, ;
Width = 0, ;
Name = "linRight1"


ADD OBJECT hscrollbar.ctnleft.linbot2 AS line WITH ;
Height = 0, ;
Left = 1, ;
Top = 13, ;
Width = 13, ;
BorderColor = RGB(128,128,128), ;
Name = "linbot2"


ADD OBJECT hscrollbar.ctnleft.linright2 AS line WITH ;
Height = 13, ;
Left = 14, ;
Top = 1, ;
Width = 0, ;
BorderColor = RGB(128,128,128), ;
Name = "linRight2"


ADD OBJECT hscrollbar.ctnleft.image1 AS image WITH ;
Picture = "leftward.bmp", ;
Height = 9, ;
Left = 4, ;
Top = 2, ;
Width = 7, ;
Name = "Image1"


ADD OBJECT ctnright AS container WITH ;
Top = 0, ;
Left = 233, ;
Width = 16, ;
Height = 15, ;
Picture = "", ;
BorderWidth = 0, ;
Enabled = .F., ;
Name = "ctnRight"


ADD OBJECT hscrollbar.ctnright.lintop AS line WITH ;
Height = 0, ;
Left = 0, ;
Top = 0, ;
Width = 16, ;
BorderColor = RGB(255,255,255), ;
Name = "lintop"


ADD OBJECT hscrollbar.ctnright.linleft AS line WITH ;
Height = 16, ;
Left = 0, ;
Top = -1, ;
Width = 0, ;
BorderColor = RGB(255,255,255), ;
Name = "linleft"


ADD OBJECT hscrollbar.ctnright.linbot1 AS line WITH ;
Height = 0, ;
Left = 0, ;
Top = 14, ;
Width = 15, ;
Name = "linbot1"


ADD OBJECT hscrollbar.ctnright.linright1 AS line WITH ;
Height = 15, ;
Left = 15, ;
Top = 0, ;
Width = 0, ;
Name = "linRight1"


ADD OBJECT hscrollbar.ctnright.linbot2 AS line WITH ;
Height = 0, ;
Left = 1, ;
Top = 13, ;
Width = 13, ;
BorderColor = RGB(128,128,128), ;
Name = "linbot2"


ADD OBJECT hscrollbar.ctnright.linright2 AS line WITH ;
Height = 13, ;
Left = 14, ;
Top = 1, ;
Width = 0, ;
BorderColor = RGB(128,128,128), ;
Name = "linRight2"


ADD OBJECT hscrollbar.ctnright.image1 AS image WITH ;
Picture = "rightward.bmp", ;
Height = 9, ;
Left = 4, ;
Top = 2, ;
Width = 7, ;
Name = "Image1"


ADD OBJECT timer1 AS timer WITH ;
Top = 0, ;
Left = 191, ;
Height = 15, ;
Width = 23, ;
Enabled = .F., ;
Interval = 15, ;
Name = "Timer1"


PROCEDURE initbar
Local nMaxWidth,i As Integer
This.Refresh(This.ctnLeft.Left-This.ctnLeft.Width-This.ctnBar.Left)
If Vartype(This.scrollobject)#"O" And !Empty(This.scrollobject) And !Isnull(This.scrollobject)
This.scrollobject=Evaluate(This.scrollobject)
Endif
oScrollObject=Iif(Vartype(This.scrollobject)#"O" Or Isnull(This.scrollobject),This.Parent,This.scrollobject)
nMaxWidth=0
For i=1 To oScrollObject.ControlCount
nMaxWidth=Max(oScrollObject.Controls(i).Left+oScrollObject.Controls(i).Width,nMaxWidth)
Endfor
This.Enabled=(nMaxWidth>oScrollObject.Width)
If This.ctnRight.Left -This.ctnLeft.Left-This.ctnLeft.Width>0
This.ctnBar.Width =(This.ctnRight.Left -This.ctnLeft.Left-This.ctnLeft.Width)*;
oScrollObject.Width/nMaxWidth
Endif
If This.ctnBar.Width <8
This.ctnBar.Width =8
Endif
This.ratio=(nMaxWidth-oScrollObject.Width)/;
(This.ctnRight.Left -This.ctnLeft.Left-This.ctnLeft.Width-This.ctnBar.Width)
ENDPROC


HIDDEN PROCEDURE enabled_assign
Lparameters vNewVal
*To do: Modify this routine for the Assign method
This.Enabled = m.vNewVal
This.ctnbar.Visible=m.vNewVal
This.ctnRight.Enabled=m.vNewVal
This.ctnLeft.Enabled=m.vNewVal
If m.vNewVal
This.ctnLeft.image1.Picture= 'leftWARD.BMP'
This.ctnRight.image1.Picture="rightward.bmp"
Else
This.ctnLeft.image1.Picture="disleftward.bmp"
This.ctnRight.image1.Picture="disrightward.bmp"
Endif
ENDPROC


HIDDEN PROCEDURE scrollobject_assign
Lparameters vNewVal
*To do: Modify this routine for the Assign method
This.scrollobject =m.vNewVal
this.initbar()
ENDPROC


PROCEDURE Init
this.resize
ENDPROC


PROCEDURE Refresh
Lparameters plus
Local nOldTop,oScrollObject,o
If PCOUNT()=0
Return
ENDIF
IF plus>0
plus=Min(plus,This.ctnRight.Left-This.ctnBar.Width-This.ctnBar.Left)
ELSE 
plus=Max(plus,This.ctnLeft.Left+This.ctnLeft.Width-This.ctnBar.Left)
ENDIF 
IF plus=0
Return
ENDIF 
If Between(This.ctnBar.Left+plus ,;
this.ctnLeft.Left+This.ctnLeft.Width,;
This.ctnRight.Left-This.ctnBar.Width)
nOldTop=This.ctnBar.Left
This.ctnBar.Left=This.ctnBar.Left+plus

oScrollObject=Iif(Vartype(This.scrollobject)#"O" Or Isnull(This.scrollobject),This.Parent,This.scrollobject)
For Each o In oScrollObject.Controls
If !INLIST(LOWER(o.class),"hscrollbar","vscrollbar")
o.Left=o.Left+(Int(nOldTop*This.ratio)-Int(This.ctnBar.Left*This.ratio))
ENDIF
ENDFOR
This.barrotate=(This.ctnBar.Left-This.ctnLeft.Left-This.ctnLeft.Width)/ ;
(This.ctnRight.Left-This.ctnBar.Left-This.ctnBar.Width)
Endif
ENDPROC


PROCEDURE Resize
This.ctnLeft.Left=1
This.ctnRight.Left=This.Width -This.ctnRight.Width-1
this.initbar()
ENDPROC


PROCEDURE MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
LOCAL oScrollObject,nHeight,o
oScrollObject=Iif(Vartype(This.scrollobject)#"O" Or Isnull(This.scrollobject),This.Parent,This.scrollobject)
*MESSAGEBOX(nYCoord)
nHeight=This.Left
o=This
DO WHILE .t.
IF o.Parent.baseclass="Form"
EXIT
ELSE
o=o.parent
IF PEMSTATUS(o,"Top",5) 
nHeight=nHeight+o.Left
ENDIF 

ENDIF 
ENDDO 
*SET STEP ON 
IF nXcoord>this.ctnbar.Left+nHeight
This.refresh(oScrollObject.Width/this.ratio)
ENDIF 
IF nXcoord<this.ctnbar.Left+nHeight
this.refresh(-1*oScrollObject.Width/this.ratio)
ENDIF
ENDPROC


PROCEDURE ctnbar.Init
This.AddProperty("XOffset",0)
ENDPROC


PROCEDURE ctnbar.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.Xoffset=nXCoord
ENDPROC


PROCEDURE ctnbar.MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
If nButton=1
If Between(This.Left+nXCoord-This.Xoffset ,;
this.Parent.ctnLeft.Left+This.Parent.ctnLeft.Width,;
This.Parent.ctnRight.Left-This.Width)
This.Parent.Refresh(nXCoord-This.Xoffset)
*This.Left=This.Left+nYCoord-This.Parent.yoffset
This.Xoffset=nXCoord
Endif
Endif
ENDPROC


PROCEDURE ctnleft.MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
If This.Enabled
This.linLEFT.Left=0
This.linTOP.Top=0

This.linbot1.Top=This.Height -1
This.linbot2.Top=This.Height -2

This.linrIGHT1.Left=This.Width-1
This.linrIGHT2.Left=This.Width-2
This.linrIGHT1.Height=This.linrIGHT1.Height+1
This.image1.Left=This.image1.Left-1
This.image1.Top=This.image1.Top-1

This.Parent.timer1.Enabled= .F.
Endif
ENDPROC


PROCEDURE ctnleft.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If This.Enabled
This.linLEFT.Left=This.Width-1
This.linTOP.Top=This.Height-1

This.linbot1.Top=0
This.linbot2.Top=1

This.linrIGHT1.Left=0
This.linrIGHT2.Left=1
This.linrIGHT1.Height=This.linrIGHT1.Height-1
This.image1.Left=This.image1.Left+1
This.image1.Top=This.image1.Top+1

This.Parent.Refresh(-1)

This.Parent.timer1.plus=-1
This.Parent.timer1.Enabled= .T.
Endif
ENDPROC


PROCEDURE image1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.Parent.MouseDown(nButton, nShift, nXCoord, nYCoord)
ENDPROC


PROCEDURE image1.MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseUp(nButton, nShift, nXCoord, nYCoord)
ENDPROC


PROCEDURE ctnright.MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
If This.Enabled
This.linLEFT.Left=0
This.linTOP.Top=0

This.linbot1.Top=This.Height -1
This.linbot2.Top=This.Height -2

This.linrIGHT1.Left=This.Width-1
This.linrIGHT2.Left=This.Width-2
This.linrIGHT1.Height=This.linrIGHT1.Height+1
This.image1.Left=This.image1.Left-1
This.image1.Top=This.image1.Top-1


This.Parent.timer1.Enabled=.F.

Endif
ENDPROC


PROCEDURE ctnright.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If This.Enabled
This.linLEFT.Left=This.Width-1
This.linTOP.Top=This.Height-1

This.linbot1.Top=0
This.linbot2.Top=1

This.linrIGHT1.Left=0
This.linrIGHT2.Left=1
This.linrIGHT1.Height=This.linrIGHT1.Height-1
This.image1.Left=This.image1.Left+1
This.image1.Top=This.image1.Top+1

This.Parent.Refresh(1)

This.Parent.timer1.plus=1
This.Parent.timer1.Enabled= .T.
Endif
ENDPROC


PROCEDURE image1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.Parent.MouseDown(nButton, nShift, nXCoord, nYCoord)
ENDPROC


PROCEDURE image1.MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseUp(nButton, nShift, nXCoord, nYCoord)
ENDPROC


PROCEDURE timer1.Init
this.AddProperty("Plus",1)
ENDPROC


PROCEDURE timer1.Timer
This.Parent.Refresh(This.plus)
ENDPROC


ENDDEFINE
*
*-- EndDefine: hscrollbar
**************************************************

[关闭][返回]