scrollbar.tcl

来自「一个跨平台的TCL/TK可视开发环境类似VC. TCL/TK是一个跨平台的脚本」· TCL 代码 · 共 523 行 · 第 1/2 页

        set runvisible 1
    }
    namespace eval ::widgets::$base.scr73 {
        array set save {-command 1}
    }
    namespace eval ::widgets::$base.lis74 {
        array set save {-background 1 -listvariable 1 -xscrollcommand 1 -yscrollcommand 1}
    }
    namespace eval ::widgets::$base.scr75 {
        array set save {-command 1 -orient 1}
    }
    namespace eval ::widgets_bindings {
        set tagslist _TopLevel
    }
    namespace eval ::vTcl::modules::main {
        set procs {
            init
            main
            fillbox
        }
        set compounds {
        }
    }
}
}

#################################
# USER DEFINED PROCEDURES
#
#############################################################################
## Procedure:  main

proc ::main {argc argv} {

}
#############################################################################
## Procedure:  fillbox

proc ::fillbox {w} {
$w delete 0 end
$w insert end apple banana orange tomato raisin peach prune pear hazelnut cherry apricot avocado pineapple grapefruit lemon mandarines {navel oranges}
}

#############################################################################
## Initialization Procedure:  init

proc ::init {argc argv} {}

init $argc $argv

#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base} {
    if {$base == ""} {
        set base .
    }
    ###################
    # CREATING WIDGETS
    ###################
    wm focusmodel $top passive
    wm geometry $top 200x200+132+150; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm withdraw $top
    wm title $top "vtcl"
    bindtags $top "$top Vtcl all"
    vTcl:FireEvent $top <<Create>>
    wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"

    ###################
    # SETTING GEOMETRY
    ###################

    vTcl:FireEvent $base <<Ready>>
}

proc vTclWindow.top72 {base} {
    if {$base == ""} {
        set base .top72
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    set top $base
    ###################
    # CREATING WIDGETS
    ###################
    vTcl:toplevel $top -class Toplevel
    wm focusmodel $top passive
    wm geometry $top 231x223+181+305; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm deiconify $top
    wm title $top "Scrollbars unbound"
    vTcl:DefineAlias "$top" "Toplevel1" vTcl:Toplevel:WidgetProc "" 1
    bindtags $top "$top Toplevel all _TopLevel"
    bind $top <<Ready>> {
        fillbox [Toplevel1.Listbox1]
    }
    vTcl:FireEvent $top <<Create>>
    wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"

    scrollbar $top.scr73
    vTcl:DefineAlias "$top.scr73" "Scrollbar1" vTcl:WidgetProc "Toplevel1" 1
    listbox $top.lis74 \
        -background white -listvariable "$top\::lis74" 
    vTcl:DefineAlias "$top.lis74" "Listbox1" vTcl:WidgetProc "Toplevel1" 1
    scrollbar $top.scr75 \
        -orient horizontal 
    vTcl:DefineAlias "$top.scr75" "Scrollbar2" vTcl:WidgetProc "Toplevel1" 1
    ###################
    # SETTING GEOMETRY
    ###################
    grid columnconf $top 0 -weight 1
    grid rowconf $top 0 -weight 1
    grid $top.scr73 \
        -in $top -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky ns 
    grid $top.lis74 \
        -in $top -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky nesw 
    grid $top.scr75 \
        -in $top -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky ew 

    vTcl:FireEvent $base <<Ready>>
}

proc vTclWindow.top76 {base} {
    if {$base == ""} {
        set base .top76
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    set top $base
    ###################
    # CREATING WIDGETS
    ###################
    vTcl:toplevel $top -class Toplevel
    wm focusmodel $top passive
    wm geometry $top +414+592; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm deiconify $top
    wm title $top "Scrollbar tutorial"
    vTcl:DefineAlias "$top" "Toplevel2" vTcl:Toplevel:WidgetProc "" 1
    bindtags $top "$top Toplevel all _TopLevel"
    vTcl:FireEvent $top <<Create>>
    wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"

    label $top.lab77 \
        -background #ececd8746cfc -padx 5 -pady 5 \
        -text {Open this project in vTcl and try yourself!} 
    vTcl:DefineAlias "$top.lab77" "Label1" vTcl:WidgetProc "Toplevel2" 1
    label $top.lab73 \
        -justify left -padx 5 -pady 5 \
        -text {It's easy.
1) Make sure the "Widget Tree" window is open.
2) Select the "Scrollbars unbound" toplevel.
   This is the window with which you can practice.
3) Select the vertical scrollbar.
   - Right-click on it.
   - Select "Widget" > "Attach to widget".
   - Click on the listbox.
4) Select the horizontal scrollbar.
   - Right-click on it.
   - Select "Widget" > "Attach to widget".
   - Click on the listbox.
5) That's it! Try resizing the window and see how the scrollbars change.} 
    vTcl:DefineAlias "$top.lab73" "Label2" vTcl:WidgetProc "Toplevel2" 1
    ###################
    # SETTING GEOMETRY
    ###################
    pack $top.lab77 \
        -in $top -anchor center -expand 0 -fill x -side top 
    pack $top.lab73 \
        -in $top -anchor center -expand 0 -fill none -side top 

    vTcl:FireEvent $base <<Ready>>
}

proc vTclWindow.top78 {base} {
    if {$base == ""} {
        set base .top78
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    set top $base
    ###################
    # CREATING WIDGETS
    ###################
    vTcl:toplevel $top -class Toplevel
    wm focusmodel $top passive
    wm geometry $top 231x223+498+153; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm deiconify $top
    wm title $top "Scrollbars bound"
    vTcl:DefineAlias "$top" "Toplevel3" vTcl:Toplevel:WidgetProc "" 1
    bindtags $top "$top Toplevel all _TopLevel"
    bind $top <<Ready>> {
        fillbox [Toplevel3.Listbox1]
    }
    vTcl:FireEvent $top <<Create>>
    wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"

    scrollbar $top.scr73 \
        -command "$top.lis74 yview" 
    vTcl:DefineAlias "$top.scr73" "Scrollbar1" vTcl:WidgetProc "Toplevel3" 1
    listbox $top.lis74 \
        -background white -xscrollcommand "$top.scr75 set" \
        -yscrollcommand "$top.scr73 set" -listvariable "$top\::lis74" 
    vTcl:DefineAlias "$top.lis74" "Listbox1" vTcl:WidgetProc "Toplevel3" 1
    scrollbar $top.scr75 \
        -command "$top.lis74 xview" -orient horizontal 
    vTcl:DefineAlias "$top.scr75" "Scrollbar2" vTcl:WidgetProc "Toplevel3" 1
    ###################
    # SETTING GEOMETRY
    ###################
    grid columnconf $top 0 -weight 1
    grid rowconf $top 0 -weight 1
    grid $top.scr73 \
        -in $top -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky ns 
    grid $top.lis74 \
        -in $top -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky nesw 
    grid $top.scr75 \
        -in $top -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky ew 

    vTcl:FireEvent $base <<Ready>>
}

#############################################################################
## Binding tag:  _TopLevel

bind "_TopLevel" <<Create>> {
    if {![info exists _topcount]} {set _topcount 0}; incr _topcount
}
bind "_TopLevel" <<DeleteWindow>> {
    destroy %W; if {$_topcount == 0} {exit}
}
bind "_TopLevel" <Destroy> {
    if {[winfo toplevel %W] == "%W"} {incr _topcount -1}
}

Window show .
Window show .top72
Window show .top76
Window show .top78

main $argc $argv