TCL canvas 滚动条不当行为

Question

我尝试在 canvas 的帮助下在 TCL 中实现一个可滚动的框架。我以某种方式设法让它工作，但它的行为有点奇怪：我只能通过按箭头来滚动，滚动条总是完全填满，所以我没有滑块代表我滚动了多远。此外，我可以上下滚动太多，超过我添加到框架的小部件的边界。我试图添加行 $base.fr.can configure -scrollregion [$base.fr.can bbox all]，但这导致我什至无法一直向下滚动，而是向上滚动太多。此外，canvas / 外框的大小与内框的大小不匹配，这意味着如果我调整根 window 的大小，canvas 会调整到某个点，但随后我在那之后只得到灰色区域。我认为这是使用 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
}

Answer 1

您的代码很长而且不起作用。您似乎没有花费任何精力来制作一个最小的工作示例。例如，#menu 部分包含一个错误（缺少“-label”的值）并且没有附加值，因为从未使用过菜单。这可能是至今无人回应的原因之一。

如您所料，配置 canvas 滚动区域可以解决您的问题。但是在你这样做的时候，框架的大小仍然是 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+frame 上的 ulis/KJN 版本，它根本不使用 canvas。

TCL canvas 滚动条不当行为

TCL canvas scrollbar misbehaviour

tk

canvas

tcl

scrollbar