frmTest = CreateObject("FORM") *With frmTest frmTest.AddObject("cntTest" ,"Container") frmTest.cntTest.Visible = .T. *----Here just make the vertical and horizontal scrollbar visible frmTest.cntTest.Left = frmTest.Width - frmTest.cntTest.Width/2 frmTest.cntTest.Left = frmTest.Height - frmTest.cntTest.Height/2 frmTest.NewObject("oScrollBarManage" ,"FrameManage" ,"ScrollBar.prg") *----or frmTest.NewObject("oScrollBarManage" ,"FrameManage" ,"ScrollBar.prg" ,.NULL. ,frmTest.cntTest) *EndWith *---- Scrollbar Manage object DEFINE CLASS FrameManage As Custom oTarget = .NULL. PROTECTED nHorizontalPercent PROTECTED nVerticalPercent PROTECTED oHorizontalScrollBar oHorizontalScrollBar = .NULL. PROTECTED oVerticalScrollBar oVerticalScrollBar = .NULL. PROTECTED oBarBlock oBarBlock = .NULL. *----- ScrollBar = 0 *---- PROTECTED nMostTop nMostTop = 0 PROTECTED nMostLeft nMostLeft = 0 PROCEDURE Init LPARAMETERS toTarget This.SetTarget(toTarget) This.ScrollBar_Assign() ENDPROC PROCEDURE Position This.oHorizontalScrollBar.Position(This.nHorizontalPercent) This.oVerticalScrollBar.Position(This.nVerticalPercent) This.ScrollBar_Assign() This.oBarBlock.Position() 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. 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 ENDFOR *---- This.nHorizontalPercent = (This.Parent.Width - 20) / This.nMostLeft This.nVerticalPercent = (This.Parent.Height - 20) / 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 This.oHorizontalScrollBar = .NULL. This.oVerticalScrollBar = .NULL. This.oBarBlock = .NULL. ENDPROC ENDDEFINE *---- Vertical ScrollBar Class 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 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 *---- *---- Horizontal ScrollBar Class 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 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 *---- Black in cross between vertcial one and horizontal one 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" nDis = (tnLeft - This.Left) / This.Parent.nPercent *---- 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" nDis = (tnTop - This.Top) / This.Parent.nPercent *---- 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