CLEAR ALL
CLEAR
Main()
CLEAR ALL
RETURN 

PROCEDURE Main()
    LOCAL loMainForm
    loMainForm = CREATEOBJECT("_MainForm")
    WITH loMainForm
        .Caption = "頁框嵌入滾動條實例程序"
        .MinWidth = 800
        .MinHeight = 600
        .AutoCenter = .T.
        .Show
    ENDWITH
    READ EVENTS
ENDPROC 

DEFINE CLASS _MainForm AS Form

    ADD OBJECT PageFrame1 AS PageFrame
   
    PROCEDURE Arrange
        LOCAL lnIndex
       
        WITH ThisForm.PageFrame1
            .Top = 5
            .Left = 5
            .Height = ThisForm.Height - .Top - 5
            .Width = ThisForm.Width - .Left - 5
            FOR lnIndex = 1 TO .PageCount
                IF .Pages(lnIndex).ControlCount > 0
                    WITH .Pages(lnIndex).Controls(1)
                        .Top = 0
                        .Left = 0
                        .Height = ThisForm.PageFrame1.Height
                        .Width = ThisForm.PageFrame1.Width
                        .Arrange
                    ENDWITH
                ENDIF
            NEXT
        ENDWITH
       
    ENDPROC
   
    PROCEDURE Activate
        ThisForm.Arrange
    ENDPROC
   
    PROCEDURE Resize
        ThisForm.Arrange
    ENDPROC 

    PROCEDURE Destroy
        CLEAR EVENTS
    ENDPROC
   
    PROCEDURE PageFrame1.Init
        WITH This
            .PageCount = 3
            WITH .Pages(1)
                .AddObject("Container1", "_WithScrollBar")
                .Container1.Visible = .T.
            ENDWITH
        ENDWITH
    ENDPROC
   
ENDDEFINE 

DEFINE CLASS _WithScrollBar AS Container

    ADD OBJECT ScrollBar1 AS OleControl WITH OleClass = "MSComCtl2.FlatScrollBar.2"
    ADD OBJECT Label1 AS Label WITH Height = 25, AutoSize = .T., Caption = "請滾動右側滾動條觀察效果：", Origin_Top = 100
    ADD OBJECT Text1 AS TextBox WITH Height = 25, Width = 100, Origin_Top = 100
   
    PROCEDURE Arrange
        WITH This.Label1
            .Top = .Origin_Top
            .Left = 10
        ENDWITH
        WITH This.Text1
            .Top = .Origin_Top
            .Left = This.Label1.Left + This.Label1.Width
        ENDWITH
        WITH This.ScrollBar1
            .Top = 0
            .Left = This.Width - 22
            .Height = This.Height - 30
        ENDWITH
    ENDPROC
   
    PROCEDURE ScrollBar1.Init
        WITH This
            .Orientation = 0
            .Min = 0
            .Max = 1000
            .SmallChange = 10
            .LargeChange = 50
        ENDWITH
    ENDPROC
   
    PROCEDURE ScrollBar1.Change
        LOCAL lnIndex
       
        FOR lnIndex = 1 TO This.Parent.ControlCount
            WITH This.Parent.Controls(lnIndex)
                IF UPPER(.Name) != UPPER("ScrollBar1")
                    .Top = .Origin_Top - This.Value
                ENDIF
            ENDWITH
        NEXT
       
    ENDPROC
   
ENDDEFINE

收到的鲜花

• tlliqi 于 2014-03-12 23:53 送鲜花  20朵   附言：辛苦了

不論垂直或水平滾動，都可以仿此方法實現，兩者同時也可以。

還有很多可以改進的地方，把這東西做成通用的也可以，祇不過爲了説明原理，簡單地寫成這樣就算了。明白了原理，怎麽都好辦。

如果有好的圖標，不用那個ActiveX控件也可以，這樣就不用擔憂發佈時遇到對方沒注冊相應控件的問題。

滾動條控件不接受鼠標滾輪事件的，因爲水平滾動條不知道應該怎麽定義它的滾動方向。要用也可以，重寫這個控件!

似乎單用鼠標滾動也可以，不用那個滾動條，我試試看。

用鼠標滾動的實現：

CLEAR ALL
CLEAR
Main()
CLEAR ALL
RETURN 

PROCEDURE Main()
    LOCAL loMainForm
    loMainForm = CREATEOBJECT("_MainForm")
    WITH loMainForm
        .Caption = "可滾動容器示例程序"
        .MinWidth = 800
        .MinHeight = 600
        .MaxWidth = 2000
        .MaxHeight = 1500
        .AutoCenter = .T.
        .Show
    ENDWITH
    READ EVENTS
ENDPROC 

*-----------------------------
* 定義主窗體
*-----------------------------
DEFINE CLASS _MainForm AS Form 

    ADD OBJECT Container1 AS _Container
   
    PROCEDURE Arrange
        WITH ThisForm.Container1
            .Top = 5
            .Left = 5
            .Height = ThisForm.Height - .Top - 5
            .Width = ThisForm.Width - .Left - 5
        ENDWITH
    ENDPROC
   
    PROCEDURE Activate
        ThisForm.Arrange
    ENDPROC
   
    PROCEDURE Resize
        ThisForm.Arrange
    ENDPROC 

    PROCEDURE Destroy
        CLEAR EVENTS
    ENDPROC
   
ENDDEFINE 

*-----------------------------
* 從可滾動容器基類繼承的子類，添加實際控件，響應事件和方法在基類中
*-----------------------------
DEFINE CLASS _Container AS ContainerWithScroll

    ADD OBJECT Label1 AS Label   WITH Caption = "請用鼠標向下滾動：", Height = 25, Width = 150, Top = 10, Left = 50, Alignment = 1
    ADD OBJECT Text1  AS TextBox WITH Height = 25, Width = 200, Top = 10, Left = 200
   
    ADD OBJECT Label2 AS Label   WITH Caption = "請用鼠標向上滾動：", Height = 25, Width = 150, Top = 800, Left = 50, Alignment = 1
    ADD OBJECT Text2  AS TextBox WITH Height = 25, Width = 200, Top = 800, Left = 200

ENDDEFINE 

*-----------------------------
* 可滾動容器基類
*-----------------------------
DEFINE CLASS ContainerWithScroll AS Container
   
    PROCEDURE Init
        LOCAL lnIndex
       
        WITH This
            FOR lnIndex = 1 TO .ControlCount
                WITH .Controls(lnIndex)
                    .AddProperty("Origin_Top", .Top)
                ENDWITH
            NEXT
        ENDWITH
       
    ENDPROC
   
    PROTECTED PROCEDURE MouseWheel(tnDirection, tnShift, tnXCoord, tnYCoord)
        LOCAL lnIndex
       
        WITH This
            FOR lnIndex = 1 TO .ControlCount
                WITH .Controls(lnIndex)
                    .Top = .Top + tnDirection
                    IF .Top > .Origin_Top
                        .Top = .Origin_Top
                    ENDIF
                ENDWITH
            NEXT
        ENDWITH
       
    ENDPROC
   
ENDDEFINE

代碼編排已預留左右滾動的設計。這裡存在一個問題，就是當動態向容器添加控件的時候，必須主動執行一次Init方法，若頁面已滾動過，坐標需要調整正確。

[ 本帖最后由 TonyDeng 于 2014-3-15 13:31 编辑 ]

要在頁Page中使用，把這個容器置入即可。若不想多一個容器層次，則用相同方法定義一個Page類，Page和Container是一樣的性質。

可以考慮往裏添加可視元素讓用戶知道控件在滾動。