发信人: lawskin(law)
整理人: foxzz(2004-12-28 08:53:32), 站内信件
|
精华区中有一滚动条源码,其实不可用,至少我复制到我的电脑中,它并不滚动.
而且代码很复杂,难以修改.
此是立向滚动条,只要将此类(自行转换成可视类)拖放到表单或表单中的任何容器内,该表单(容器)内的所有物件就可滚动.当然可以指定在执行时指定其他容器(不可以在属性框中直接输入).
此类开放的属性仅scrollobject,指定卷动时针对哪个容器.不设定则针对类的父容器.开放的方法initbar:在scrollobject的resize中要加入initbar
类的关键代码都在initbar和refresh方法中,其次是MOUSE动作,其余代码是可有可无的.所使用的图形,就要自备了,名称分别是:
UPWARD.BMP
downward.bmp
disupward.bmp
disdownward.bmp
**************************************************
*-- Class: vscrollbar (f:\winson8\myclass.vcx)
*-- ParentClass: container
*-- BaseClass: container
*-- Time Stamp: 11/06/04 02:40:01 PM
*
DEFINE CLASS vscrollbar AS container
Width = 17
Height = 225
BorderWidth = 0
BackColor = RGB(230,230,230)
scrollobject = ""
HIDDEN barrotate
barrotate = 0
HIDDEN ratio
ratio = 0
Name = "vscrollbar"
ADD OBJECT ctnbar AS container WITH ;
Top = 15, ;
Left = 0, ;
Width = 16, ;
Height = 66, ;
SpecialEffect = 0, ;
Name = "ctnBar"
ADD OBJECT ctnup AS container WITH ;
Top = 0, ;
Left = 0, ;
Width = 16, ;
Height = 15, ;
BorderWidth = 0, ;
Name = "ctnup"
ADD OBJECT vscrollbar.ctnup.lintop AS line WITH ;
Height = 0, ;
Left = 0, ;
Top = 0, ;
Width = 16, ;
BorderColor = RGB(255,255,255), ;
Name = "lintop"
ADD OBJECT vscrollbar.ctnup.linleft AS line WITH ;
Height = 16, ;
Left = 0, ;
Top = -1, ;
Width = 0, ;
BorderColor = RGB(255,255,255), ;
Name = "linleft"
ADD OBJECT vscrollbar.ctnup.linbot1 AS line WITH ;
Height = 0, ;
Left = 0, ;
Top = 14, ;
Width = 15, ;
Name = "linbot1"
ADD OBJECT vscrollbar.ctnup.linright1 AS line WITH ;
Height = 15, ;
Left = 15, ;
Top = 0, ;
Width = 0, ;
Name = "linRight1"
ADD OBJECT vscrollbar.ctnup.linbot2 AS line WITH ;
Height = 0, ;
Left = 1, ;
Top = 13, ;
Width = 13, ;
BorderColor = RGB(128,128,128), ;
Name = "linbot2"
ADD OBJECT vscrollbar.ctnup.linright2 AS line WITH ;
Height = 13, ;
Left = 14, ;
Top = 1, ;
Width = 0, ;
BorderColor = RGB(128,128,128), ;
Name = "linRight2"
ADD OBJECT vscrollbar.ctnup.image1 AS image WITH ;
Picture = "upward.bmp", ;
Height = 7, ;
Left = 3, ;
Top = 4, ;
Width = 9, ;
Name = "Image1"
ADD OBJECT ctndown AS container WITH ;
Top = 209, ;
Left = 0, ;
Width = 16, ;
Height = 15, ;
Picture = "", ;
BorderWidth = 0, ;
Enabled = .F., ;
Name = "ctndown"
ADD OBJECT vscrollbar.ctndown.lintop AS line WITH ;
Height = 0, ;
Left = 0, ;
Top = 0, ;
Width = 16, ;
BorderColor = RGB(255,255,255), ;
Name = "lintop"
ADD OBJECT vscrollbar.ctndown.linleft AS line WITH ;
Height = 16, ;
Left = 0, ;
Top = -1, ;
Width = 0, ;
BorderColor = RGB(255,255,255), ;
Name = "linleft"
ADD OBJECT vscrollbar.ctndown.linbot1 AS line WITH ;
Height = 0, ;
Left = 0, ;
Top = 14, ;
Width = 15, ;
Name = "linbot1"
ADD OBJECT vscrollbar.ctndown.linright1 AS line WITH ;
Height = 15, ;
Left = 15, ;
Top = 0, ;
Width = 0, ;
Name = "linRight1"
ADD OBJECT vscrollbar.ctndown.linbot2 AS line WITH ;
Height = 0, ;
Left = 1, ;
Top = 13, ;
Width = 13, ;
BorderColor = RGB(128,128,128), ;
Name = "linbot2"
ADD OBJECT vscrollbar.ctndown.linright2 AS line WITH ;
Height = 13, ;
Left = 14, ;
Top = 1, ;
Width = 0, ;
BorderColor = RGB(128,128,128), ;
Name = "linRight2"
ADD OBJECT vscrollbar.ctndown.image1 AS image WITH ;
Picture = "downward.bmp", ;
Height = 7, ;
Left = 3, ;
Top = 3, ;
Width = 9, ;
Name = "Image1"
ADD OBJECT timer1 AS timer WITH ;
Top = 117, ;
Left = 5, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 15, ;
Name = "Timer1"
PROCEDURE initbar
Local nMaxHeight,i As Integer
*由于難以計算SCROLLBAR及目標控件的當前狀況,
*每次重新計算時,先恢復到初始狀態
*這樣,每次更改容器大小(RESIZE)時,SCROLLBAR會回到頂部
*初始化控件時亦如此
This.Refresh(This.ctnup.Top-This.ctnup.Height-This.ctnBar.Top)
*先檢查是否指定了被卷動的容器,如未指定或指定無效,
*則為本身的父容器
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)
*計算容器中控件需要的最大高度
nMaxHeight=0
For i=1 To oScrollObject.ControlCount
nMaxHeight=Max(oScrollObject.Controls(i).Top+oScrollObject.Controls(i).Height,nMaxHeight)
Endfor
*如果容器中控件需要的最大高度小于容器高度,則卷動條不顯示
This.Enabled=(nMaxHeight>oScrollObject.Height)
*計算卷動條的高度,卷動條高度/卷動空間高度=容器高度/容器中控件需要的最大高度
*并且最小高度為8PIXL
If This.ctndown.Top -This.ctnup.Top-This.ctnup.Height>0
This.ctnBar.Height =(This.ctndown.Top -This.ctnup.Top-This.ctnup.Height)*;
oScrollObject.Height/nMaxHeight
Endif
If This.ctnBar.Height <8
This.ctnBar.Height =8
Endif
*計算卷動空間高度每一PIXL的實際對應比率.即卷軸每移動一點,實際控件應移動的點數
This.ratio=(nMaxHeight-oScrollObject.Height)/;
(This.ctndown.Top -This.ctnup.Top-This.ctnup.Height-This.ctnBar.Height)
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.ctndown.Enabled=m.vNewVal
This.ctnup.Enabled=m.vNewVal
If m.vNewVal
This.ctnup.image1.Picture= 'UPWARD.BMP'
This.ctndown.image1.Picture="downward.bmp"
Else
This.ctnup.image1.Picture="disupward.bmp"
This.ctndown.image1.Picture="disdownward.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 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.top
o=This
DO WHILE .t.
IF o.Parent.baseclass="Form"
EXIT
ELSE
o=o.parent
IF PEMSTATUS(o,"Top",5)
nHeight=nHeight+o.Top
ENDIF
ENDIF
ENDDO
*SET STEP ON
IF nYcoord>this.ctnbar.top+nHeight
This.refresh(oScrollObject.Height/this.ratio)
ENDIF
IF nYcoord<this.ctnbar.top+nHeight
this.refresh(-1*oScrollObject.Height/this.ratio)
ENDIF
ENDPROC
PROCEDURE Resize
This.ctnup.Top=1
This.ctndown.Top=This.Height -This.ctndown.Height-1
this.initbar()
ENDPROC
PROCEDURE Refresh
*當卷軸發生移動時,執行此程序, plus為位移點數.
Lparameters plus
Local nOldTop,oScrollObject,o
If PCOUNT()=0
Return
ENDIF
*如果沒有指定位移量,或位移為0時,不執行
*如果plus>0,即向下移動時,取plus和可移動位移的較小值
*如果plus<0,即向上移動時,取plus和可移動位移的較大值(絕對值的較小值)
IF plus>0
plus=Min(plus,This.ctndown.Top-This.ctnBar.Height-This.ctnBar.Top)
ELSE
plus=Max(plus,This.ctnup.Top+This.ctnup.Height-This.ctnBar.Top)
ENDIF
IF plus=0
Return
ENDIF
*此處的條件判斷已屬多餘.
If Between(This.ctnBar.Top+plus ,;
this.ctnup.Top+This.ctnup.Height,;
This.ctndown.Top-This.ctnBar.Height)
nOldTop=This.ctnBar.Top
This.ctnBar.Top=This.ctnBar.Top+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")
*因為PIXL只取整數,此處若用plus*This.ratio,
*因小數點誤差而造成每個控件移動的位移不一致,
*如-3-1.2=-4,4-3=1,只移動一點, 12-1.2=10,12-10=2,移動2點
*為避免這種誤差,必須使用一個固定的整數點.
o.Top=o.Top+(Int(nOldTop*This.ratio)-Int(This.ctnBar.Top*This.ratio))
ENDIF
ENDFOR
*RATIO:記錄卷動條上每一點對應的控件實際高度
*barrotate:記錄每次移動後,卷動條上下空間高度的比例
This.barrotate=(This.ctnBar.Top-This.ctnup.Top-This.ctnup.Height)/ ;
(This.ctndown.Top-This.ctnBar.Top-This.ctnBar.Height)
Endif
ENDPROC
PROCEDURE Init
this.resize
ENDPROC
PROCEDURE ctnbar.Init
this.AddProperty("YOffset",0)
ENDPROC
PROCEDURE ctnbar.MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
If nButton=1
If Between(This.Top+nYCoord-This.yoffset ,;
this.Parent.ctnup.Top+This.Parent.ctnup.Height,;
This.Parent.ctndown.Top-This.Height)
This.Parent.Refresh(nYCoord-This.yoffset)
*This.Top=This.Top+nYCoord-This.Parent.yoffset
This.yoffset=nYCoord
Endif
Endif
ENDPROC
PROCEDURE ctnbar.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.yoffset=nYCoord
ENDPROC
PROCEDURE ctnup.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 ctnup.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 image1.MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseUp(nButton, nShift, nXCoord, nYCoord)
ENDPROC
PROCEDURE image1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.Parent.MouseDown(nButton, nShift, nXCoord, nYCoord)
ENDPROC
PROCEDURE ctndown.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 ctndown.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 image1.MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseUp(nButton, nShift, nXCoord, nYCoord)
ENDPROC
PROCEDURE image1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.Parent.MouseDown(nButton, nShift, nXCoord, nYCoord)
ENDPROC
PROCEDURE timer1.Timer
This.Parent.Refresh(This.plus)
ENDPROC
PROCEDURE timer1.Init
this.AddProperty("Plus",1)
ENDPROC
ENDDEFINE
*
*-- EndDefine: vscrollbar
**************************************************
|
|