发信人: coolyylu(GoodDay)
整理人: foxzz(2002-04-23 20:48:27), 站内信件
|
*--- 有一部分是foxer帮我修改的。这里谢谢foxer
* --- Foxer0
* --- Foxer1
CLEAR ALL
_Screen.NewObject("cntTest" ,"Container")
_SCREEN.cntTest.Top = 30
_SCREEN.cntTest.Left = 30
_SCREEN.cntTest.Width = 200
_SCREEN.cntTest.Height = 200
_SCREEN.cntTest.NewObject("edtObj", "EditBox")
_SCREEN.cntTest.edtObj.Top = 40
_SCREEN.cntTest.edtObj.Left = 20
_SCREEN.cntTest.edtObj.Width = 300
_SCREEN.cntTest.edtObj.Height = 500
_SCREEN.cntTest.edtObj.Visible = .T.
_Screen.cntTest.NewObject("Line1" ,"Line")
_SCREEN.cntTest.Line1.Top = 541
_SCREEN.cntTest.Line1.Left = 0
_SCREEN.cntTest.Line1.Height = 0
_SCREEN.cntTest.Line1.Width = 200
_SCREEN.cntTest.Line1.BorderColor=RGB(255,0,0)
_SCREEN.cntTest.Line1.Visible = .T.
_SCREEN.cntTest.NewObject("edtObj1", "EditBox")
_SCREEN.cntTest.edtObj1.Top = 541
_SCREEN.cntTest.edtObj1.Left = 20
_SCREEN.cntTest.edtObj1.Width = 30
_SCREEN.cntTest.edtObj1.Height = 50
_SCREEN.cntTest.edtObj1.Visible = .T.
_Screen.cntTest.NewObject("mgrSc" ,"FrameManage" ,"scroll.prg" )
_Screen.cntTest.mgrSc.Init()
_SCREEN.cntTest.Visible = .T.
DEFINE CLASS FrameManage As Custom
oTarget = .NULL.
*---- Scroll Page Percent
PROTECTED nHorizontalPercent
PROTECTED nVerticalPercent
oHorizontalScrollBar = .NULL.
oVerticalScrollBar = .NULL.
PROTECTED oBarBlock
oBarBlock = .NULL.
ScrollBar = 0
PROTECTED nMostTop
nMostTop = 0
PROTECTED nMostLeft
nMostLeft = 0
* ---- Foxer0
nRefTop = 0
nRefLeft = 0
oRefControl = .NULL.
* ---- Foxer1
PROCEDURE Init
LPARAMETERS toTarget
This.SetTarget(toTarget)
This.ScrollBar_Assign()
ENDPROC
PROCEDURE Position
IF VARTYPE(This.oHorizontalScrollBar) = 'O' AND NOT ISNULL(This.oHorizontalScrollBar)
This.oHorizontalScrollBar.Position(This.nHorizontalPercent)
ENDIF
IF VARTYPE(This.oVerticalScrollBar) = 'O' AND NOT ISNULL(This.oVerticalScrollBar)
This.oVerticalScrollBar.Position(This.nVerticalPercent)
ENDIF
This.ScrollBar_Assign()
This.oBarBlock.Position()
ENDPROC
PROCEDURE PagePosition
IF VARTYPE(This.oHorizontalScrollBar) = 'O' AND NOT ISNULL(This.oHorizontalScrollBar)
This.oHorizontalScrollBar.PagePosition(This.nHorizontalPercent)
ENDIF
IF VARTYPE(This.oVerticalScrollBar) = 'O' AND NOT ISNULL(This.oVerticalScrollBar)
This.oVerticalScrollBar.PagePosition(This.nVerticalPercent)
ENDIF
ENDPROC
PROCEDURE SetTarget
LPARAMETERS toTarget
This.oTarget = toTarget
ENDPROC
PROCEDURE GetControlSize
LPARAMETERS cType
IF cType = "TOP"
RETURN This.nMostTop
ENDIF
IF cType = "LEFT"
RETURN This.nMostLeft
ENDIF
RETURN 0
ENDPROC
PROCEDURE CheckScrollBar
IF VARTYPE(This.nHorizontalPercent) = 'L'
This.nHorizontalPercent = 1
ENDIF
IF VARTYPE(This.nVerticalPercent ) = 'L'
This.nVerticalPercent = 1
ENDIF
oControl = .NULL.
* --- Foxer0
lFirst = .T.
* --- Foxer1
FOR EACH oControl IN This.Parent.Controls
* IF NOT INLIST(UPPER(oControl.Class) ,"BARBLOCK" ,"HORIZONTALSCROLLBAR" ,"VERTICALSCROLLBAR")
This.nMostTop = MAX(oControl.Top + oControl.Height ,This.nMostTop)
This.nMostLeft = MAX(oControl.Left + oControl.Width ,This.nMostLeft )
*ENDIF
* --- Foxer0
IF lFirst
This.nRefTop = oControl.Top
This.nRefLeft = oControl.Left
This.oRefControl = oControl
lFirst = .F.
ENDIF
* --- Foxer1
ENDFOR
This.nHorizontalPercent = (This.Parent.Width - 20.000 ) / This.nMostLeft &&- 20.000
This.nVerticalPercent = (This.Parent.Height -20.000) / This.nMostTop &&
nResult = 0
IF This.nHorizontalPercent < 1
nResult = nResult + 1
ENDIF
IF This.nVerticalPercent < 1
nResult = nResult + 2
ENDIF
RETURN nResult
ENDPROC
PROTECTED PROCEDURE SetVerticalScrollBarVisible
LPARAMETERS tlVisible
IF VARTYPE(This.oVerticalScrollBar) # 'O' OR ISNULL(This.oVerticalScrollBar)
IF tlVisible
This.Parent.AddObject("scVerticalScrollBar" ,"VerticalScrollBar" , This ,This.nVerticalPercent)
cVerticalScrollBar = "This.Parent.scVerticalScrollBar"
This.oVerticalScrollBar = &cVerticalScrollBar
RELEASE cVerticalScrollBar
This.oVerticalScrollBar.Visible = .T.
ENDIF
ELSE
This.oVerticalScrollBar.Visible = tlVisible
ENDIF
ENDPROC
PROTECTED PROCEDURE SetHorizontalScrollBarVisible
LPARAMETERS tlVisible
IF VARTYPE(This.oHorizontalScrollBar) # 'O' OR ISNULL(This.oHorizontalScrollBar)
IF tlVisible
This.Parent.AddObject("scHorizontalScrollBar" ,"HorizontalScrollBar" ,This ,This.nHorizontalPercent)
cHorizontalScrollBar = "This.Parent.scHorizontalScrollBar"
This.oHorizontalScrollBar = &cHorizontalScrollBar
RELEASE cHorizontalScrollBar
This.oHorizontalScrollBar.Visible = .T.
ENDIF
ELSE
This.oHorizontalScrollBar.Visible = tlVisible
ENDIF
ENDPROC
PROTECTED PROCEDURE SetBarBlockVisible
LPARAMETERS tlVisible
IF VARTYPE(This.oBarBlock) # 'O' OR ISNULL(This.oBarBlock)
IF tlVisible
This.Parent.AddObject("scBarBlock" ,"BarBlock")
cBarBlock = "This.Parent.scBarBlock"
This.oBarBlock = &cBarBlock
RELEASE cBarBlock
This.oBarBlock.Visible = .T.
ENDIF
ELSE
This.oBarBlock.Visible = tlVisible
ENDIF
ENDPROC
PROCEDURE ScrollBar_Assign
LPARAMETERS tnScrollBarType
IF EMPTY(tnScrollBarType)
tnScrollBarType = THIS.CheckScrollBar()
ENDIF
This.ScrollBar = tnScrollBarType
DO CASE
CASE tnScrollBarType = 0
This.SetVerticalScrollBarVisible(.F.)
This.SetHorizontalScrollBarVisible(.F.)
This.SetBarBlockVisible(.F.)
CASE tnScrollBarType = 1
This.SetVerticalScrollBarVisible(.F.)
This.SetHorizontalScrollBarVisible(.T.)
This.SetBarBlockVisible(.T.)
CASE tnScrollBarType = 2
This.SetVerticalScrollBarVisible(.T.)
This.SetHorizontalScrollBarVisible(.F.)
This.SetBarBlockVisible(.T.)
CASE tnScrollBarType = 3
This.SetVerticalScrollBarVisible(.T.)
This.SetHorizontalScrollBarVisible(.T.)
This.SetBarBlockVisible(.T.)
ENDCASE
ENDPROC
PROCEDURE Destroy
IF VARTYPE(This.oVerticalScrollBar) = 'O' AND NOT ISNULL(This.oVerticalScrollBar)
cObject = This.oVerticalScrollBar.Name
This.Parent.RemoveObject(cObject)
ENDIF
IF VARTYPE(This.oHorizontalScrollBar) = 'O' AND NOT ISNULL(This.oHorizontalScrollBar)
cObject = This.oHorizontalScrollBar.Name
This.Parent.RemoveObject(cObject)
ENDIF
IF VARTYPE(This.oBarBlock) = 'O' AND NOT ISNULL(This.oBarBlock)
cObject = This.oBarBlock.Name
This.Parent.RemoveObject(cObject)
ENDIF
This.oHorizontalScrollBar = .NULL.
This.oVerticalScrollBar = .NULL.
This.oBarBlock = .NULL.
ENDPROC
ENDDEFINE
DEFINE CLASS VerticalScrollBar As container
BackColor = 12615808
BorderColor = RGB(255,255,255)
Width = 20
nPercent = 0
nMouseDis = 0
oFrameManage = .NULL.
ADD OBJECT shpSlider As SliderShape
PROCEDURE Init
LPARAMETERS toFrameManage ,tnPercent
This.nPercent = tnPercent
This.oFrameManage = toFrameManage
This.Position(tnPercent)
This.Visible = .T.
ENDPROC
PROCEDURE Position
LPARAMETERS tnPercent
This.Height = This.Parent.Height - 20
This.Left = This.Parent.Width - This.Width
This.Top = 0
WITH This.shpSlider
.Left = 2
.Top = 0
.Width = This.Width - 4
.Height = This.Height * tnPercent
.BackColor = This.BorderColor - 10
.Bordercolor = This.BackColor
ENDWITH
ENDPROC
PROCEDURE PagePosition
LPARAMETERS tnPercent
WITH This.shpSlider
.Height = This.Height * tnPercent
ENDWITH
ENDPROC
PROCEDURE shpSlider.MouseDown
LPARAMETERS nButton ,nShift ,nX ,nY
IF nButton = 1
This.Tag = "MOUSEDOWN"
This.Parent.nMouseDis = nY - This.Parent.Top - This.Top
ENDIF
ENDPROC
PROCEDURE shpSlider.MouseMove
LPARAMETERS nButton ,nShift ,nX ,nY
IF This.Tag = "MOUSEDOWN"
DO CASE
CASE (nY + This.Height - This.Parent.nMouseDis - This.Parent.Top) >= This.Parent.Height
This.Top = This.Parent.Height - This.Height
CASE (nY - This.Parent.nMouseDis - This.Parent.Top) <= 0
This.Top = 0
OTHERWISE
This.Top = nY - This.Parent.nMouseDis - This.Parent.Top
ENDCASE
ENDIF
ENDPROC
PROCEDURE shpSlider.MouseUP
LPARAMETERS nButton ,nShift ,nX ,nY
IF This.Tag = "MOUSEDOWN"
This.Tag = "MOUSEUP"
ENDIF
ENDPROC
PROCEDURE Destroy
This.oFrameManage = .NULL.
ENDPROC
ENDDEFINE
DEFINE CLASS HorizontalScrollBar As container
BackColor = 12615808
BorderColor = RGB(255,255,255)
Height = 20
nPercent = 0
nMouseDis = 0
oFrameManage = .NULL.
ADD OBJECT shpSlider As SliderShape
PROCEDURE Init
LPARAMETERS toFrameManage ,tnPercent
This.nPercent = tnPercent
This.oFrameManage = toFrameManage
This.Position(tnPercent)
This.Visible = .T.
ENDPROC
PROCEDURE Position
LPARAMETERS tnPercent
This.Width = This.Parent.Width - 20
This.Left = 0
This.Top = This.Parent.Height - This.Height
WITH This.shpSlider
.Left = 0
.Top = 2
.Width = This.Width * tnPercent
.Height = This.Height - 4
.BackColor = This.BorderColor - 10
.BorderColor = This.BackColor
ENDWITH
ENDPROC
PROCEDURE PagePosition
LPARAMETERS tnPercent
WITH This.shpSlider
.Width = This.Width * tnPercent
ENDWITH
ENDPROC
PROCEDURE shpSlider.MouseDown
LPARAMETERS nButton ,nShift ,nX ,nY
IF nButton = 1
This.Tag = "MOUSEDOWN"
This.Parent.nMouseDis = nX - This.Parent.Left - This.Left
ENDIF
ENDPROC
PROCEDURE shpSlider.MouseMove
LPARAMETERS nButton ,nShift ,nX ,nY
IF This.Tag = "MOUSEDOWN"
DO CASE
CASE (nX + This.Width - This.Parent.nMouseDis - This.Parent.Left) >= This.Parent.Width
This.Left = This.Parent.Width - This.Width
CASE (nX - This.Parent.nMouseDis - This.Parent.Left ) <= 0
This.Left = 0
OTHERWISE
This.Left = nX - This.Parent.nMouseDis - This.Parent.Left
ENDCASE
ENDIF
ENDPROC
PROCEDURE shpSlider.MouseUP
LPARAMETERS nButton ,nShift ,nX ,nY
This.Tag = "MOUSEUP"
ENDPROC
PROCEDURE Destroy
This.oFrameManage = .NULL.
ENDPROC
ENDDEFINE
DEFINE CLASS BarBlock As Control
Width = 20
Height = 20
BackColor = 12615808
BorderColor = RGB(255,255,255)
ADD OBJECT Line1 As Line WITH BorderColor = RGB(255,255,255) ,LineSlant = "/",Width = 20 ,Height = 20 ,LEFT =0 ,TOP =0
ADD OBJECT Line2 As Line WITH BorderColor = RGB(255,255,255) ,LineSlant = "/",Width = 15 ,Height = 15 ,Left =5 ,Top = 5
ADD OBJECT Line3 As Line WITH BorderColor = RGB(255,255,255) ,LineSlant = "/",Width = 10 ,Height = 10 ,Left =10 ,Top = 10
PROCEDURE Init
This.Position()
This.Visible = .T.
ENDPROC
PROCEDURE Position
This.Left = This.Parent.Width - This.Width
This.Top = This.Parent.Height - This.Height
ENDPROC
ENDDEFINE
DEFINE CLASS SliderShape As Shape
PROCEDURE Left_Assign
LPARAMETERS tnLeft
IF This.Tag = "MOUSEDOWN"
* --- Foxer0
nPosition100 = This.Parent.Width - This.Width
nPercent = tnLeft/nPosition100
nCurLeft = INT(nPercent * (This.Parent.oFrameManage.GetControlSize("LEFT") - This.Parent.Width))
nDis = nCurLeft - (This.Parent.oFrameManage.nRefLeft - This.Parent.oFrameManage.oRefControl.Left)
IF VARTYPE(This.Parent.oFrameManage.oTarget) = 'O' AND NOT ISNULL(This.Parent.oFrameManage.oTarget)
This.Parent.oFrameManage.oTarget.Left = This.Parent.oFrameManage.oTarget.Left - nDis
ELSE
FOR EACH oObject IN This.Parent.Parent.Controls
IF NOT INLIST(UPPER(oObject.Class) ,"BARBLOCK" ,"HORIZONTALSCROLLBAR" ,"VERTICALSCROLLBAR")
oObject.Left = oObject.Left - nDis
ENDIF
ENDFOR
ENDIF
ENDIF
This.Left = tnLeft
ENDPROC
PROCEDURE Top_Assign
LPARAMETERS tnTop
IF This.Tag = "MOUSEDOWN"
* --- Foxer0
nPosition100 = This.Parent.Height - This.Height
nPercent = tnTop/nPosition100
nCurTop = INT(nPercent * (This.Parent.oFrameManage.GetControlSize("TOP")-This.Parent.Height))
nDis = nCurTop - (This.Parent.oFrameManage.nRefTop - This.Parent.oFrameManage.oRefControl.Top)
IF VARTYPE(This.Parent.oFrameManage.oTarget) = 'O' AND NOT ISNULL(This.Parent.oFrameManage.oTarget)
This.Parent.oFrameManage.oTarget.Top = This.Parent.oFrameManage.oTarget.Top - nDis
ELSE
FOR EACH oObject IN This.Parent.Parent.Controls
IF NOT INLIST(UPPER(oObject.Class) ,"BARBLOCK" ,"HORIZONTALSCROLLBAR" ,"VERTICALSCROLLBAR")
oObject.Top = oObject.Top - nDis
ENDIF
ENDFOR
ENDIF
ENDIF
This.Top = tnTop
ENDPROC
ENDDEFINE
|
|