##########################################
#
# 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-2005Another new alternative is scrodget. A new generic-scrolled-widget (really close to the BWidgets's ScrolledWindow).
