在 TCL/TK 中使用单个滚动条滚动两个小部件。

Scrolling two widgets using single scrollbar in TCL/TK.

我创建了两个树控件小部件和一个滚动条小部件。现在我正在尝试创建一个功能,用户可以选择使用滚动条,因为会有单选按钮选项来决定哪个小部件随滚动条一起滚动。我从 here 得到了一些关于如何将两个小部件滚动到一起的想法。但不确定如何创建可切换的滚动条。我的代码如下:

package require Tk
package require treectrl

namespace eval ::at::GUI {
  variable Priv;
  variable OptionsRB;

  set Priv(treePrimary) "";
  set Priv(treeSecondary) "";
  set Priv(treeScrollbar) "";

  if { ![info exists OptionsRB] } { 
    set OptionsRB(scrollTree) "LeftTree";
  }
}

proc ::at::GUI::DrawGUI {} {
  variable Priv;

  set frm_treeFrame [ttk::labelframe .treeFrame -text "Tree Area"];      
  set Priv(treePrimary) [treectrl $frm_treeFrame.treePrimary]
  set Priv(treeSecondary) [treectrl $frm_treeFrame.treeSecondary]    
  set Priv(treeScrollbar) [ttk::scrollbar $frm_treeFrame.sb_treeScroll -command "::at::GUI::yview"]

  grid $Priv(treePrimary) $Priv(treeSecondary) $Priv(treeScrollbar) -sticky news;
  grid columnconfigure $frm_treeFrame 0 -weight 1;
  grid columnconfigure $frm_treeFrame 1 -weight 1;
  grid rowconfigure $frm_treeFrame 0 -weight 1;

  set frm_ST [ttk::labelframe .scrollTreeOptions -text "Scroll Option"];  
  set rb_leftTree [ttk::radiobutton $frm_ST.rb1 -text "Left Tree" -variable [namespace current]::OptionsRB(scrollTree) -value LeftTree -command [namespace current]::configScroll ]
  set rb_rightTree [ttk::radiobutton $frm_ST.rb2 -text "Right Tree" -variable [namespace current]::OptionsRB(scrollTree) -value RightTree -command [namespace current]::configScroll ] 
  set rb_bothTree [ttk::radiobutton $frm_ST.rb3 -text "Both Tree" -variable [namespace current]::OptionsRB(scrollTree) -value BothTree -command [namespace current]::configScroll ] 

  grid $rb_leftTree -row 1 -padx {30 5} -pady 5 -sticky w
  grid $rb_rightTree -row 2 -padx {30 5} -pady 5 -sticky w
  grid $rb_bothTree -row 3 -padx {30 5} -pady 5 -sticky w

  # Grid all the frames in main window. 
  grid $frm_treeFrame -sticky news;
  grid $frm_ST -sticky news;

  ##############################
  ::at::GUI::CreateLemes $Priv(treePrimary)
  ::at::GUI::CreateLemes $Priv(treeSecondary)

  foreach tree [list $Priv(treePrimary) $Priv(treeSecondary)] {
    for {set i 0} {$i < 20} {incr i} {
      set parent [expr {int(rand()*$i)}]
      $tree item create -tag item$i -button auto
      $tree item lastchild $parent item$i
      $tree item text item$i name item$i
    }
  }
  return;  
}

proc ::at::GUI::CreateLemes {T} {
  $T element create rect rect -fill [list blue selected]
  $T element create name text

  set S [$T style create nameStyle]
  $T style elements $S {rect name};
  $T style layout $S rect -detach yes -iexpand xy;
  $T style layout $S name -detach no -iexpand xy -expand e;

  $T column create -tag name -itemstyle $S -text Items
  $T configure -treecolumn first;
}

proc ::at::GUI::configScroll {args}  {
  variable Priv;
  variable OptionsRB;

  if {$OptionsRB(scrollTree) eq "LeftTree"} {
    #$Priv(treeSecondary) -yscrollcommand "";
    $Priv(treePrimary) -yscrollcommand "::at::GUI::yset $Priv(treeScrollbar)";
  } elseif {$OptionsRB(scrollTree) eq "RightTree"} {
    #$Priv(treePrimary) -yscrollcommand "";
    $Priv(treeSecondary) -yscrollcommand "::at::GUI::yset $Priv(treeScrollbar)";
  } elseif {$OptionsRB(scrollTree) eq "BothTree"} {
    $Priv(treePrimary) -yscrollcommand "::at::GUI::yset $Priv(treeScrollbar)";
    $Priv(treeSecondary) -yscrollcommand "::at::GUI::yset $Priv(treeScrollbar)";
  }
}

proc ::at::GUI::yset {sb args}  {
  uplevel [linsert $args 0 $sb set]
  ::at::GUI::yview moveto [lindex [$sb get] 0]
}

proc ::at::GUI::yview {args}  {
  variable Priv;
  variable OptionsRB;
  if {$OptionsRB(scrollTree) eq "LeftTree"} {
    eval [linsert $args 0 $Priv(treePrimary) yview];
  } elseif {$OptionsRB(scrollTree) eq "RightTree"} {
    eval [linsert $args 0 $Priv(treeSecondary) yview];
  } elseif {$OptionsRB(scrollTree) eq "BothTree"} {
    eval [linsert $args 0 $Priv(treePrimary) yview];
    eval [linsert $args 0 $Priv(treeSecondary) yview];
  }
}

问题是,每当我尝试点击单选按钮时,我都会收到一条错误消息:

bad command "-yscrollcommand": must be activate, bbox, canvasx, canvasy, cget, collapse, column, compare, configure, contentbox, debug, depth, dragimage, element, expand, gradient, header, identify, index, item, marquee, notify, numcolumns, numitems, orphans, range, scan, see, selection, state, style, theme, toggle, xview, or yview bad command "-yscrollcommand": must be activate, bbox, canvasx, canvasy, cget, collapse, column, compare, configure, contentbox, debug, depth, dragimage, element, expand, gradient, header, identify, index, item, marquee, notify, numcolumns, numitems, orphans, range, scan, see, selection, state, style, theme, toggle, xview, or yview while executing "$Priv(treeSecondary) -yscrollcommand "::at::GUI::yset $Priv(treeScrollbar)"" (procedure "::at::GUI::configScroll" line 10) invoked from within "::at::GUI::configScroll" invoked from within ".scrollTreeOptions.rb2 invoke " invoked from within ".scrollTreeOptions.rb2 instate {pressed !disabled} { .scrollTreeOptions.rb2 state !pressed; .scrollTreeOptions.rb2 invoke } " (command bound to event)

但有趣的是,即使出现错误,如果我移动滚动条,它也会在小部件之间切换并按需要工作。但是错误是我无法理解的。

这是我的第一个传统知识项目,所以我不确定我是否遗漏了一些重要信息。任何意见??

错误信息是关键。实际上,包含在 Priv(treeSecondary) 变量中的命令没有名为 -yscrollcommand 的子命令。我认为您想使用 configure 子命令来更改 -yscrollcommand 选项的值。尝试类似的东西:

$Priv(treeSecondary) configure -yscrollcommand "::at::GUI::yset $Priv(treeScrollbar)"