发信人: 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
************************************************** |
|