TCL画布滚动条行为不端



我试图在画布的帮助下在TCL中实现一个可滚动的框架。我设法让它发挥了作用,但它的行为有点奇怪:我只能通过按下箭头来滚动,滚动条总是完全填满的,所以我没有代表我滚动了多远的滑块。此外,我可以上下滚动太多,超过我添加到框架中的小部件的边界。我试图添加$base.fr.can configure -scrollregion [$base.fr.can bbox all]行,但这导致我甚至无法一直向下滚动,而是向上滚动太多。此外,画布/外框的大小与内框的大小不匹配,这意味着如果我调整根窗口的大小,画布会调整到某个点,但之后我只得到灰色区域。我认为这就是使用columnconfigure和rowconfigure的意义所在,这样就不会发生这种情况。我想要实现的是:最初我只是有一个带有小部件的框架。但在程序执行过程中,可以添加更多的小部件,而且我遇到了小部件太多而无法全部显示的问题,所以我想为该帧设置一个滚动条。代码:

proc name_space::gui_create {root} {
variable base [expr {($root eq ".") ? "" : $root}]
variable fontSmall "Helvetica 12"
variable fontMedium "Helvetica 14"
variable fontLarge "Helvetica 16"
variable fontLog "Courier 10"
variable fontCheckmark "Helvetica 24"

#menu
menu .mainm
menu .mainm.filem
menu .mainm.filem.options
.mainm add cascade -menu .mainm.filem
.mainm.filem add cascade -menu .mainm.filem.options -label 
.mainm.filem.options add checkbutton -variable var_state -command [namespace code [list some_random_proc]] 
-label "Do stuff"
#main scrollbar
ttk::frame $base.fr
canvas $base.fr.can -yscrollcommand "$base.fr.yscroll set" -width 800 -height 400
ttk::scrollbar $base.fr.yscroll -command "$base.fr.can yview"
grid $base.fr -row 0 -column 0 -sticky nwes
grid columnconfigure $root $base.fr -weight 1
grid rowconfigure $root $base.fr -weight 1
grid $base.fr.can -row 0 -column 0 -sticky nswe
grid $base.fr.yscroll -row 0 -column 1 -sticky ns
grid columnconfigure $base.fr $base.fr.can -weight 1
grid rowconfigure $base.fr $base.fr.can -weight 1
ttk::frame $base.fr.can.fr_inner
$base.fr.can create window 0 0 -anchor nw -window $base.fr.can.fr_inner
set base $base.fr.can.fr_inner
# widgets: workspace management
ttk::frame $base.wf
ttk::label $base.wf.l -font $fontSmall -text "Workspace:"
ttk::combobox $base.wf.selection -state readonly -values $ws_list 
-exportselection 0 -font $fontSmall
bind $base.wf.selection <<ComboboxSelected>> 
[namespace code [list on_workspace_selected %W 1]]
ttk::button $base.wf.create -text "Create..." 
-command [namespace code [list on_create_workspace_clicked]]
ttk::button $base.wf.backup -text "Backup Workspace to Desktop" 
-command [namespace code [list on_backup_workspace_clicked]]
ttk::button $base.wf.restore -text "Restore Backup" 
-command [namespace code [list on_restore_workspace_clicked]]

# widgets: slots
ttk::frame $base.f
ttk::button $base.f.t1 -text "text1" 
-command [namespace code [list some_proc]]
ttk::button $base.f.t2 -text "text2" 
-command [namespace code [list some_proc_2]]
ttk::button $base.f.t3 -text "text3" 
-command [namespace code [list some_proc_3]]
ttk::button $base.f.t4 -text "text4" 
-command [namespace code [list some_proc_4]]
# widgets: log window
ttk::frame $base.lf
ttk::scrollbar $base.lf.scroll -command [list $base.lf.log yview]
text $base.lf.log 
-yscrollcommand [list $base.lf.scroll set] 
-font $fontLog 
-height 10 
-state disabled
$base.lf.log tag configure stdout -background white
$base.lf.log tag configure stderr -background #ffcccc
$base.lf.log tag configure info -background #ccffff 
-font [concat $fontLog "bold"]
$base.lf.log tag configure error -background #ccffff 
-font [concat $fontLog "bold"] -foreground #ff0000
# layout: workspace management
grid $base.wf -column 0 -row 0 -sticky nwe -pady {0 20}
grid columnconfigure $base $base.wf -weight 1
grid $base.wf.l -column 0 -row 0 -sticky w -padx 15
grid $base.wf.selection -column 1 -columnspan 2 -row 0 -sticky we
grid columnconfigure $base.wf $base.wf.selection -weight 1
grid $base.wf.create -column 3 -row 0 -sticky e -padx 15
grid $base.wf.backup -column 1 -row 1 -sticky we -padx 5 -pady {3 0}
grid $base.wf.restore -column 2 -row 1 -sticky we -padx 5 -pady {3 0}
# layout: slots
grid $base.f -column 0 -row 1 -sticky nwes
grid columnconfigure $base $base.f -weight 1
grid $base.f.t1 -column 0 -row 0 -sticky w -pady 5
grid $base.f.t2 -column 0 -row 1 -sticky w -pady 5
grid $base.f.t3 -column 0 -row 2 -sticky w -pady 5
grid $base.f.t4 -column 0 -row 3 -sticky w -pady 5

#show on workspace selected
grid remove $base.f
# layout: log window
grid $base.lf -column 0 -row 2 -sticky nwes
grid rowconfigure $base $base.lf -weight 1
grid $base.lf.log -column 0 -row 0 -sticky nwes
grid rowconfigure $base.lf $base.lf.log -weight 1
grid columnconfigure $base.lf $base.lf.log -weight 1
grid $base.lf.scroll -column 1 -row 0 -sticky nes
grid rowconfigure $base.lf $base.lf.scroll -weight 1
}

您的代码很长,无法工作。你似乎没有花任何精力来做一个最小的工作示例。例如,#菜单部分包含一个错误(缺少"-label"的值(,并且没有添加值,因为菜单从未使用过。这可能是没有人回应的原因之一。

正如您所怀疑的,配置画布滚动区域可以解决您的问题。但在你这样做的时候,帧仍然有1x1像素的大小。当内部框架完成并且几何图形管理器有机会计算出最终尺寸时,必须运行该命令。如果您在以后更改内部框架的大小,例如通过添加或删除小部件,则应重新配置滚动区域。

这两件事都可以通过绑定到<配置>内框事件:

bind $base.fr.can.fr_inner <Configure> [list apply [list can {
$can configure -scrollregion [$can bbox all]
}] $base.fr.can]

正如前面所做的那样,您也可以利用现有的代码来创建一个滚动的框架。我特别喜欢位于https://wiki.tcl-lang.org/page/A+scrolled+框架,它根本不使用画布。

最新更新