AJB - I put this together because I'm tired of having to set up the scrollbars, and I don't always want to load packages that have a lot of dependencies. More and more I am interested in packaging Snit with all of my apps, so here is a wrapper for any scrollable widget that will take care of all of your scrollbar woes. PS, not tested on Mac. Sorry.
AJB - Oct 18, 04 - A few changes to incorporate a -scalewidget option based on this [L1 ]. If the option is set to true, the widget uses scales instead of scrollbars.
PAK - Jan 5, 05 - Suppress scrollbar thrashing on text widget when only the last line is too long. When that happens, a horizontal scroll bar is needed, which means the last line gets replaced by the scroll bar, which means that none of the visible lines are too long, which means that the scroll bar gets removed, which means the last line is too long....
########################################## # # snitscrollwindow.tcl # # Package to provide a wrapper around any scrollable widget # i.e. - text, listbox, canvas # # The scrollbars should have all of the proper bindings # The scrollbars will auto hide/appear as needed # # Options: # -windowtype -- defaults to canvas, but can be any scrollable widget # -scalewidget -- boolean option, if set to true scale widgets will be used in # place of the scrollbars # these options can only be set at creation time # -- all other options are passed to the internal widget itself # -- scrollbar options can be configured using the xscroll/yscroll methods # # Methods: # xscroll -- calling xscroll will cause all remaining args to be sent to the x-scrollbar # example $win xscroll configure -width 12 # -- all of the usual default snit methods configure, cget, etc # # Results: # calling snit::widget with the path of an empty container widget will provide a -windowtype with # scrollbars that appear and disappear as needed, and that have all of the correct bindings package provide snitScrollWindow 0.2 package require Tk package require snit snit::widget snitScrollWindow { # since this option is configured in the constructor, it should not be set to read-only ! option -windowtype -default canvas -validatemethod IsScrollableWidget -readonly no option -scalewidget -default 0 -validatemethod BooleanOption -readonly yes delegate option * to mainWindow delegate method * to mainWindow variable mainWindow variable scrollGrid -array {} constructor {args} { catch {$self configurelist $args} set widget [$self cget -windowtype] set mainWindow [$widget $win.main] $self configure -yscrollcommand [mymethod ScrollHandle $win.y] -xscrollcommand [mymethod ScrollHandle $win.x] grid $mainWindow -row 0 -column 0 -sticky nesw grid columnconfigure $win 0 -weight 1 grid rowconfigure $win 0 -weight 1 if {[$self cget -scalewidget]} { scale $win.y -orient vertical -command [mymethod WindowScaleScroll $mainWindow yview] -width 12 -from 0 -to 1000 -show 0 scale $win.x -orient horizontal -command [mymethod WindowScaleScroll $mainWindow xview] -width 12 -from 0 -to 1000 -show 0 } else { scrollbar $win.y -orient vertical -command [list $self yview] -width 12 scrollbar $win.x -orient horizontal -command [list $self xview] -width 12 } grid $win.y -row 0 -column 1 -sticky ns grid $win.x -row 1 -column 0 -sticky ew set scrollGrid($win.y) [grid info $win.y] set scrollGrid($win.x) [grid info $win.x] if {$widget eq "canvas"} {bind $mainWindow <Expose> {%W configure -scrollregion [%W bbox all]}} bind $mainWindow <Button-4> [list $self yview scroll -1 units] bind $mainWindow <Button-5> [list $self yview scroll 1 units] bind $mainWindow <Shift-Button-4> [list $self xview scroll -1 units] bind $mainWindow <Shift-Button-5> [list $self xview scroll 1 units] bind $mainWindow <Button> [mymethod HorizScroll %b] bind $mainWindow <MouseWheel> {%W yview scroll [expr {int(pow(%D/-120,3))}] units} bind $mainWindow <Shift-MouseWheel> {%W xview scroll [expr {int(pow(%D/-120,3))}] units} $self configurelist $args } method xscroll {args} {eval {$win.x} $args} method yscroll {args} {eval {$win.y} $args} method HorizScroll {btn} { if {$btn == 6} { $mainWindow xview scroll -1 units } elseif {$btn == 7} { $mainWindow xview scroll 1 units } } variable suppress ;#PAK method ScrollHandle {w first last} { if {[$self cget -scalewidget]} { if {[set val [expr 1.0 - ($last - $first)]] > 0.0} {set val [expr int(1000 / $val * $first)]} $w set $val } else { $w set $first $last } variable suppress ;#PAK if { ![info exists suppress($w)] } { ;#PAK set suppress($w) 1 ;#PAK if {$first <= 0 && $last >= 1} { grid forget $w } else { eval {grid $w} $scrollGrid($w) } update ;#PAK unset suppress($w) ;#PAK } ;#PAK } method WindowScaleScroll {w axis pos} { foreach {first last} [$w $axis] break set val [expr 1.0 - ($last - $first)] set val [expr ($val / 1000) * $pos] $w $axis moveto $val } method BooleanOption {option value} { if {$value eq ""} {set value 1} if {![string is boolean -strict $value]} {error "expected a boolean values, got \"$value\""} } method IsScrollableWidget {opt widget args} { if {[catch {$widget $win.temp -yscrollcommand {}}]} {error "$widget is not a scrollable widget"} destroy $win.temp } }
And some test code:
package require snitScrollWindow pack [snitScrollWindow .fr] -fill both -expand 1 .fr create oval 0 0 200 200 .fr create oval 200 200 300 300 .fr xscroll configure -width 10 -bg black .fr yscroll configure -width 10 -bg black toplevel .n pack [snitScrollWindow .n.fr -windowtype text -width 15 -wrap none] -fill both -expand 1 for {set x 0} {$x < 50} {incr x} {.n.fr insert end "This is line number $x \n"}
ABU Take a look at a very similar widget :scanvas ..
AJB Interesting, but it doesn't seem to incorporate all of the various mousewheel bindings, which was part of why I wrote this.... And, it doesn't auto-hide the scrollbars when they are not needed, which is the other part of why I wrote this.
ABU 26-jan-2005
Another new alternative is scrodget. A new generic-scrolled-widget (really close to the BWidgets's ScrolledWindow).