BWidgets has a scrollableframe widget to fill this gap left by tcl/tk (even as new as 8.6). Tk demo suggested to embed widgets into the scrollable [text] widget. In case you favor neither of them, here is a scrollableframe widget not depending on BWidget.
[ulis], 2003-06-28: A hacked package to scroll a frame in pure Tcl/Tk.
2003-11-07, v 0.9.1: automatic scroll on resize.
[ulis], 24-10-2005: see at the bottom the [KJN] optimized & enhanced version.
[http://wfr.tcl.tk/fichiers/ulis/ScrolledFrame.gif]
download: http://wiki.tcl.tk/_repo/ulis/Scrolledframe.zip
[[Anyone up for explaining how it works? Seems like it uses [place]…]]
----
**The package**
======
if {[info exists ::scrolledframe::version]} { return }
namespace eval ::scrolledframe \
{
# beginning of ::scrolledframe namespace definition
namespace export scrolledframe
# ==============================
#
# scrolledframe
set version 0.9.1
#
# a scrolled frame
#
# (C) 2003, ulis
#
# NOL licence (No Obligation Licence)
#
# ==============================
#
# Hacked package, no documentation, sorry
# See example at bottom
#
# ------------------------------
# v 0.9.1
# automatic scroll on resize
# ==============================
package provide Scrolledframe $version
# --------------
#
# create a scrolled frame
#
# --------------
# parm1: widget name
# parm2: options key/value list
# --------------
proc scrolledframe {w args} \
{
variable {}
# create a scrolled frame
frame $w
# trap the reference
rename $w ::scrolledframe::_$w
# redirect to dispatch
interp alias {} $w {} ::scrolledframe::dispatch $w
# create scrollable internal frame
frame $w.scrolled -highlightt 0 -padx 0 -pady 0
# place it
place $w.scrolled -in $w -x 0 -y 0
# init internal data
set ($w:vheight) 0
set ($w:vwidth) 0
set ($w:vtop) 0
set ($w:vleft) 0
set ($w:xscroll) ""
set ($w:yscroll) ""
# configure
if {$args != ""} { uplevel 1 ::scrolledframe::config $w $args }
# bind <Configure>
bind $w <Configure> [namespace code [list vresize $w]]
bind $w.scrolled <Configure> [namespace code [list resize $w]]
# return widget ref
return $w
}
# --------------
#
# dispatch the trapped command
#
# --------------
# parm1: widget name
# parm2: operation
# parm2: operation args
# --------------
proc dispatch {w cmd args} \
{
variable {}
switch -glob -- $cmd \
{
con* { uplevel 1 [linsert $args 0 ::scrolledframe::config $w] }
xvi* { uplevel 1 [linsert $args 0 ::scrolledframe::xview $w] }
yvi* { uplevel 1 [linsert $args 0 ::scrolledframe::yview $w] }
default { uplevel 1 [linsert $args 0 ::scrolledframe::_$w $cmd] }
}
}
# --------------
# configure operation
#
# configure the widget
# --------------
# parm1: widget name
# parm2: options
# --------------
proc config {w args} \
{
variable {}
set options {}
set flag 0
foreach {key value} $args \
{
switch -glob -- $key \
{
-xsc* \
{
# new xscroll option
set ($w:xscroll) $value
set flag 1
}
-ysc* \
{
# new yscroll option
set ($w:yscroll) $value
set flag 1
}
default { lappend options $key $value }
}
}
# check if needed
if {!$flag || $options != ""} \
{
# call frame config
uplevel 1 [linsert $options 0 ::scrolledframe::_$w config]
}
}
# --------------
# resize proc
#
# resize the scrolled region
# --------------
# parm1: widget name
# --------------
proc resize {w} \
{
variable {}
# compute new height & width
set ($w:vheight) [winfo reqheight $w.scrolled]
set ($w:vwidth) [winfo reqwidth $w.scrolled]
# resize the scroll bars
vresize $w
}
# --------------
# vresize proc
#
# resize the visible part
# --------------
# parm1: widget name
# --------------
proc vresize {w} \
{
xview $w scroll 0 unit
yview $w scroll 0 unit
xset $w
yset $w
}
# --------------
# xset proc
#
# resize the visible part
# --------------
# parm1: widget name
# --------------
proc xset {w} \
{
variable {}
# call the xscroll command
set cmd $($w:xscroll)
if {$cmd != ""} { catch { eval $cmd [xview $w] } }
}
# --------------
# yset proc
#
# resize the visible part
# --------------
# parm1: widget name
# --------------
proc yset {w} \
{
variable {}
# call the yscroll command
set cmd $($w:yscroll)
if {$cmd != ""} { catch { eval $cmd [yview $w] } }
}
# -------------
# xview
#
# called on horizontal scrolling
# -------------
# parm1: widget path
# parm2: optional moveto or scroll
# parm3: fraction if parm2 == moveto, count unit if parm2 == scroll
# -------------
# return: scrolling info if parm2 is empty
# -------------
proc xview {w {cmd ""} args} \
{
variable {}
# check args
set len [llength $args]
switch -glob -- $cmd \
{
"" {}
mov* \
{ if {$len != 1} { error "wrong # args: should be \"$w xview moveto fraction\"" } }
scr* \
{ if {$len != 2} { error "wrong # args: should be \"$w xview scroll count unit\"" } }
default \
{ error "unknown operation \"$cmd\": should be empty, moveto or scroll" }
}
# save old values
set _vleft $($w:vleft)
set _vwidth $($w:vwidth)
set _width [winfo width $w]
# compute new vleft
set count ""
switch $len \
{
0 \
{
# return fractions
if {$_vwidth == 0} { return {0 1} }
set first [expr {double($_vleft) / $_vwidth}]
set last [expr {double($_vleft + $_width) / $_vwidth}]
if {$last > 1.0} { return {0 1} }
return [list $first $last]
}
1 \
{
# absolute movement
set vleft [expr {int(double($args) * $_vwidth)}]
}
2 \
{
# relative movement
foreach {count unit} $args break
if {[string match p* $unit]} { set count [expr {$count * 9}] }
set vleft [expr {$_vleft + $count * 0.1 * $_width}]
}
}
if {$vleft < 0} { set vleft 0 }
if {$vleft + $_width > $_vwidth} { set vleft [expr {$_vwidth - $_width}] }
if {$vleft != $_vleft || $count == 0} \
{
set ($w:vleft) $vleft
xset $w
place $w.scrolled -in $w -x [expr {-$vleft}]
}
}
# -------------
# yview
#
# called on vertical scrolling
# -------------
# parm1: widget path
# parm2: optional moveto or scroll
# parm3: fraction if parm2 == moveto, count unit if parm2 == scroll
# -------------
# return: scrolling info if parm2 is empty
# -------------
proc yview {w {cmd ""} args} \
{
variable {}
# check args
set len [llength $args]
switch -glob -- $cmd \
{
"" {}
mov* \
{ if {$len != 1} { error "wrong # args: should be \"$w yview moveto fraction\"" } }
scr* \
{ if {$len != 2} { error "wrong # args: should be \"$w yview scroll count unit\"" } }
default \
{ error "unknown operation \"$cmd\": should be empty, moveto or scroll" }
}
# save old values
set _vtop $($w:vtop)
set _vheight $($w:vheight)
set _height [winfo height $w]
# compute new vtop
set count ""
switch $len \
{
0 \
{
# return fractions
if {$_vheight == 0} { return {0 1} }
set first [expr {double($_vtop) / $_vheight}]
set last [expr {double($_vtop + $_height) / $_vheight}]
if {$last > 1.0} { return {0 1} }
return [list $first $last]
}
1 \
{
# absolute movement
set vtop [expr {int(double($args) * $_vheight)}]
}
2 \
{
# relative movement
foreach {count unit} $args break
if {[string match p* $unit]} { set count [expr {$count * 9}] }
set vtop [expr {$_vtop + $count * 0.1 * $_height}]
}
}
if {$vtop < 0} { set vtop 0 }
if {$vtop + $_height > $_vheight} { set vtop [expr {$_vheight - $_height}] }
if {$vtop != $_vtop || $count == 0} \
{
set ($w:vtop) $vtop
yset $w
place $w.scrolled -in $w -y [expr {-$vtop}]
puts "place $w.scrolled -in $w -y [expr {-$vtop}]"
}
}
# end of ::scrolledframe namespace definition
}
======
----
**The demo**
======
# ==============================
#
# demo
#
# ==============================
if {[catch {package require Scrolledframe}]} \
{
source [file join [file dirname [info script]] scrolledframe.tcl]
package require Scrolledframe
}
namespace import ::scrolledframe::scrolledframe
scrolledframe .sf -height 150 -width 100 \
-xscroll {.hs set} -yscroll {.vs set}
scrollbar .vs -command {.sf yview}
scrollbar .hs -command {.sf xview} -orient horizontal
grid .sf -row 0 -column 0 -sticky nsew
grid .vs -row 0 -column 1 -sticky ns
grid .hs -row 1 -column 0 -sticky ew
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1
set f .sf.scrolled
foreach i {0 1 2 3 4 5 6 7 8 9} \
{
label $f.l$i -text "Hi! I'm the scrolled label $i" -relief groove
pack $f.l$i -padx 10 -pady 2
}
======
----
**Another demo**
======
# packages
source ../Scrolledframe/scrolledframe.tcl
namespace import ::scrolledframe::scrolledframe
package require Tk
# create widgets
set bd 2
set bd2 [expr {$bd * 2}]
frame .f0 -bd 1 -relief groove
frame .f1
button .f1._A4 -text A4 -width 10 -command {size A4}
button .f1._A3 -text A3 -width 10 -command {size A3}
pack .f1._A4 .f1._A3 -padx 10 -pady 10 -side left
scrolledframe .f2 -xscrollc {.hs set} -yscrollc {.vs set}
canvas .f2.scrolled.c -bd 1 -relief ridge \
-highlightt 0 -bg beige
.f2.scrolled.c create text 0 0 -tags size
pack .f2.scrolled.c
scrollbar .vs -command {.f2 yview}
scrollbar .hs -command {.f2 xview} -orient horizontal
# place widgets
grid .f0 -row 1 -column 0 -sticky nsew
grid .f1 -row 0 -column 0 -columnspan 2
grid .f2 -row 1 -column 0
grid .vs -row 1 -column 1 -sticky ns
grid .hs -row 2 -column 0 -sticky ew
grid rowconfigure . 1 -weight 1
grid columnconfigure . 0 -weight 1
wm geometry . 300x400
# sizing the canvas
proc size {size} \
{
switch $size \
{
A3 { set width 297; set height 420 }
A4 { set width 210; set height 297 }
}
set c .f2.scrolled.c
$c config -width $width -height $height
set bd [$c cget -bd]
set bd*2 [expr {$bd * 2}]
.f2 config -width [incr width ${bd*2}] -height [incr height ${bd*2}]
$c coords size [expr {$width / 2}] [expr {$height / 2}]
$c itemconfig size -text $size
}
# init
size A4
======
----
**See also**
* [Scrolled.frame]
* [scrolledframe]
* [Scrollutil]
----
**Wrapper**
Roalt, June 30th, 2003
To use the scrolledframe without thinking about adding scrollbars, use the following
wrapper to replace your "set f [[frame .f]]" call by a "set f [[scrollframe .f]]" call:
[ulis], 2003-06-30: When using the wrapper, be aware to only use the grid geometry manager inside the parent of the frame. This because the wrapper uses it and that geometry managers can't be mixed.
----
======
# function to wrap the scrolledframe package
proc scrollframe { fname args } {
set parent [eval frame $fname $args]
scrolledframe $parent.sf \
-xscroll "$parent.hs set" -yscroll "$parent.vs set"
scrollbar $parent.vs -command "$parent.sf yview"
scrollbar $parent.hs -command "$parent.sf xview" -orient horizontal
grid $parent.sf -row 0 -column 0 -sticky nsew
grid $parent.vs -row 0 -column 1 -sticky ns
grid $parent.hs -row 1 -column 0 -sticky ew
grid rowconfigure $parent 0 -weight 1
grid columnconfigure $parent 0 -weight 1
return $parent.sf.scrolled
}
======
----
A fully wrapped example that also passes the arguments to the scrolled internal frame.
======
proc Scrolled_Frame { fname args } {
set parent [eval frame $fname $args]
scrolledframe $parent.sf -xscroll [list $parent.hs set] -yscroll [list $parent.vs set]
foreach {arg1 arg2} $args {
$parent.sf.scrolled configure $arg1 $arg2
}
scrollbar $parent.vs -command [list $parent.sf yview] -orient vertical
scrollbar $parent.hs -command [list $parent.sf xview] -orient horizontal
grid $parent.sf -row 0 -column 0 -sticky news
grid $parent.vs -row 0 -column 1 -sticky ns
grid $parent.hs -row 1 -column 0 -sticky ew
grid rowconfigure $parent 0 -weight 1
grid columnconfigure $parent 0 -weight 1
return $parent.sf.scrolled
}
set blah [Scrolled_Frame .sf -bg #ffffff -relief sunken -bd 50]
set blah2 [Scrolled_Frame .sf2]
set blah3 [Scrolled_Frame .sf3 -bg #666666 -relief groove -bd 2]
set x 0
while {$x < 100} {
label $blah.$x -text "This is a Scrolled Frame."
grid $blah.$x -row $x -column $x -sticky news
label $blah2.$x -text "This is also a Scrolled Frame."
grid $blah2.$x -row $x -column $x -sticky news
label $blah3.$x -text "You guessed it."
grid $blah3.$x -row $x -column $x -sticky news
incr x
}
pack .sf -fill both -expand true
pack .sf2 -fill both -expand true
pack .sf3 -fill both -expand true
======
----
**The KJN optimized & enhanced version**
======
if {[info exists ::scrolledframe::version]} { return }
namespace eval ::scrolledframe \
{
# beginning of ::scrolledframe namespace definition
package require Tk 8.4
namespace export scrolledframe
# ==============================
#
# scrolledframe
set version 0.9.1
set (debug,place) 0
#
# a scrolled frame
#
# (C) 2003, ulis
#
# NOL licence (No Obligation Licence)
#
# Changes (C) 2004, KJN
#
# NOL licence (No Obligation Licence)
# ==============================
#
# Hacked package, no documentation, sorry
# See example at bottom
#
# ------------------------------
# v 0.9.1
# automatic scroll on resize
# ==============================
package provide Scrolledframe $version
# --------------
#
# create a scrolled frame
#
# --------------
# parm1: widget name
# parm2: options key/value list
# --------------
proc scrolledframe {w args} \
{
variable {}
# create a scrolled frame
frame $w
# trap the reference
rename $w ::scrolledframe::_$w
# redirect to dispatch
interp alias {} $w {} ::scrolledframe::dispatch $w
# create scrollable internal frame
frame $w.scrolled -highlightt 0 -padx 0 -pady 0
# place it
place $w.scrolled -in $w -x 0 -y 0
if {$(debug,place)} { puts "place $w.scrolled -in $w -x 0 -y 0" } ;#DEBUG
# init internal data
set ($w:vheight) 0
set ($w:vwidth) 0
set ($w:vtop) 0
set ($w:vleft) 0
set ($w:xscroll) ""
set ($w:yscroll) ""
set ($w:width) 0
set ($w:height) 0
set ($w:fillx) 0
set ($w:filly) 0
# configure
if {$args != ""} { uplevel 1 ::scrolledframe::config $w $args }
# bind <Configure>
bind $w <Configure> [namespace code [list resize $w]]
bind $w.scrolled <Configure> [namespace code [list resize $w]]
# return widget ref
return $w
}
# --------------
#
# dispatch the trapped command
#
# --------------
# parm1: widget name
# parm2: operation
# parm2: operation args
# --------------
proc dispatch {w cmd args} \
{
variable {}
switch -glob -- $cmd \
{
con* { uplevel 1 [linsert $args 0 ::scrolledframe::config $w] }
xvi* { uplevel 1 [linsert $args 0 ::scrolledframe::xview $w] }
yvi* { uplevel 1 [linsert $args 0 ::scrolledframe::yview $w] }
default { uplevel 1 [linsert $args 0 ::scrolledframe::_$w $cmd] }
}
}
# --------------
# configure operation
#
# configure the widget
# --------------
# parm1: widget name
# parm2: options
# --------------
proc config {w args} \
{
variable {}
set options {}
set flag 0
foreach {key value} $args \
{
switch -glob -- $key \
{
-fill \
{
# new fill option: what should the scrolled object do if it is smaller than the viewing window?
if {$value == "none"} {
set ($w:fillx) 0
set ($w:filly) 0
} elseif {$value == "x"} {
set ($w:fillx) 1
set ($w:filly) 0
} elseif {$value == "y"} {
set ($w:fillx) 0
set ($w:filly) 1
} elseif {$value == "both"} {
set ($w:fillx) 1
set ($w:filly) 1
} else {
error "invalid value: should be \"$w configure -fill value\", where \"value\" is \"x\", \"y\", \"none\", or \"both\""
}
resize $w force
set flag 1
}
-xsc* \
{
# new xscroll option
set ($w:xscroll) $value
set flag 1
}
-ysc* \
{
# new yscroll option
set ($w:yscroll) $value
set flag 1
}
default { lappend options $key $value }
}
}
# check if needed
if {!$flag || $options != ""} \
{
# call frame config
uplevel 1 [linsert $options 0 ::scrolledframe::_$w config]
}
}
# --------------
# resize proc
#
# Update the scrollbars if necessary, in response to a change in either the viewing window
# or the scrolled object.
# Replaces the old resize and the old vresize
# A <Configure> call may mean any change to the viewing window or the scrolled object.
# We only need to resize the scrollbars if the size of one of these objects has changed.
# Usually the window sizes have not changed, and so the proc will not resize the scrollbars.
# --------------
# parm1: widget name
# parm2: pass anything to force resize even if dimensions are unchanged
# --------------
proc resize {w args} \
{
variable {}
set force [llength $args]
set _vheight $($w:vheight)
set _vwidth $($w:vwidth)
# compute new height & width
set ($w:vheight) [winfo reqheight $w.scrolled]
set ($w:vwidth) [winfo reqwidth $w.scrolled]
# The size may have changed, e.g. by manual resizing of the window
set _height $($w:height)
set _width $($w:width)
set ($w:height) [winfo height $w] ;# gives the actual height of the viewing window
set ($w:width) [winfo width $w] ;# gives the actual width of the viewing window
if {$force || $($w:vheight) != $_vheight || $($w:height) != $_height} {
# resize the vertical scroll bar
yview $w scroll 0 unit
# yset $w
}
if {$force || $($w:vwidth) != $_vwidth || $($w:width) != $_width} {
# resize the horizontal scroll bar
xview $w scroll 0 unit
# xset $w
}
} ;# end proc resize
# --------------
# xset proc
#
# resize the visible part
# --------------
# parm1: widget name
# --------------
proc xset {w} \
{
variable {}
# call the xscroll command
set cmd $($w:xscroll)
if {$cmd != ""} { catch { eval $cmd [xview $w] } }
}
# --------------
# yset proc
#
# resize the visible part
# --------------
# parm1: widget name
# --------------
proc yset {w} \
{
variable {}
# call the yscroll command
set cmd $($w:yscroll)
if {$cmd != ""} { catch { eval $cmd [yview $w] } }
}
# -------------
# xview
#
# called on horizontal scrolling
# -------------
# parm1: widget path
# parm2: optional moveto or scroll
# parm3: fraction if parm2 == moveto, count unit if parm2 == scroll
# -------------
# return: scrolling info if parm2 is empty
# -------------
proc xview {w {cmd ""} args} \
{
variable {}
# check args
set len [llength $args]
switch -glob -- $cmd \
{
"" {set args {}}
mov* \
{ if {$len != 1} { error "wrong # args: should be \"$w xview moveto fraction\"" } }
scr* \
{ if {$len != 2} { error "wrong # args: should be \"$w xview scroll count unit\"" } }
default \
{ error "unknown operation \"$cmd\": should be empty, moveto or scroll" }
}
# save old values:
set _vleft $($w:vleft)
set _vwidth $($w:vwidth)
set _width $($w:width)
# compute new vleft
set count ""
switch $len \
{
0 \
{
# return fractions
if {$_vwidth == 0} { return {0 1} }
set first [expr {double($_vleft) / $_vwidth}]
set last [expr {double($_vleft + $_width) / $_vwidth}]
if {$last > 1.0} { return {0 1} }
return [list $first $last]
}
1 \
{
# absolute movement
set vleft [expr {int(double($args) * $_vwidth)}]
}
2 \
{
# relative movement
foreach {count unit} $args break
if {[string match p* $unit]} { set count [expr {$count * 9}] }
set vleft [expr {$_vleft + $count * 0.1 * $_width}]
}
}
if {$vleft + $_width > $_vwidth} { set vleft [expr {$_vwidth - $_width}] }
if {$vleft < 0} { set vleft 0 }
if {$vleft != $_vleft || $count == 0} \
{
set ($w:vleft) $vleft
xset $w
if {$($w:fillx) && ($_vwidth < $_width || $($w:xscroll) == "") } {
# "scrolled object" is not scrolled, because it is too small or because no scrollbar was requested
# fillx means that, in these cases, we must tell the object what its width should be
place $w.scrolled -in $w -x [expr {-$vleft}] -width $_width
if {$(debug,place)} { puts "place $w.scrolled -in $w -x [expr {-$vleft}] -width $_width" } ;#DEBUG
} else {
place $w.scrolled -in $w -x [expr {-$vleft}] -width {}
if {$(debug,place)} { puts "place $w.scrolled -in $w -x [expr {-$vleft}] -width {}" } ;#DEBUG
}
}
}
# -------------
# yview
#
# called on vertical scrolling
# -------------
# parm1: widget path
# parm2: optional moveto or scroll
# parm3: fraction if parm2 == moveto, count unit if parm2 == scroll
# -------------
# return: scrolling info if parm2 is empty
# -------------
proc yview {w {cmd ""} args} \
{
variable {}
# check args
set len [llength $args]
switch -glob -- $cmd \
{
"" {set args {}}
mov* \
{ if {$len != 1} { error "wrong # args: should be \"$w yview moveto fraction\"" } }
scr* \
{ if {$len != 2} { error "wrong # args: should be \"$w yview scroll count unit\"" } }
default \
{ error "unknown operation \"$cmd\": should be empty, moveto or scroll" }
}
# save old values
set _vtop $($w:vtop)
set _vheight $($w:vheight)
# set _height [winfo height $w]
set _height $($w:height)
# compute new vtop
set count ""
switch $len \
{
0 \
{
# return fractions
if {$_vheight == 0} { return {0 1} }
set first [expr {double($_vtop) / $_vheight}]
set last [expr {double($_vtop + $_height) / $_vheight}]
if {$last > 1.0} { return {0 1} }
return [list $first $last]
}
1 \
{
# absolute movement
set vtop [expr {int(double($args) * $_vheight)}]
}
2 \
{
# relative movement
foreach {count unit} $args break
if {[string match p* $unit]} { set count [expr {$count * 9}] }
set vtop [expr {$_vtop + $count * 0.1 * $_height}]
}
}
if {$vtop + $_height > $_vheight} { set vtop [expr {$_vheight - $_height}] }
if {$vtop < 0} { set vtop 0 }
if {$vtop != $_vtop || $count == 0} \
{
set ($w:vtop) $vtop
yset $w
if {$($w:filly) && ($_vheight < $_height || $($w:yscroll) == "")} {
# "scrolled object" is not scrolled, because it is too small or because no scrollbar was requested
# filly means that, in these cases, we must tell the object what its height should be
place $w.scrolled -in $w -y [expr {-$vtop}] -height $_height
if {$(debug,place)} { puts "place $w.scrolled -in $w -y [expr {-$vtop}] -height $_height" } ;#DEBUG
} else {
place $w.scrolled -in $w -y [expr {-$vtop}] -height {}
if {$(debug,place)} { puts "place $w.scrolled -in $w -y [expr {-$vtop}] -height {}" } ;#DEBUG
}
}
}
# end of ::scrolledframe namespace definition
}
======
----
**The KJN demo**
======
# ==============================
#
# demo
#
# ==============================
if {[catch {package require Scrolledframe}]} \
{
source [file join [file dirname [info script]] sf9223.2.tcl]
package require Scrolledframe
}
namespace import ::scrolledframe::scrolledframe
scrolledframe .sf -height 150 -width 100 \
-xscrollcommand {.hs set} -yscrollcommand {.vs set} -fill both ;# try both, x, y or none
scrollbar .vs -command {.sf yview}
scrollbar .hs -command {.sf xview} -orient horizontal
grid .sf -row 0 -column 0 -sticky nsew
grid .vs -row 0 -column 1 -sticky ns
grid .hs -row 1 -column 0 -sticky ew
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1
set f .sf.scrolled
# .sf configure -bg white
foreach i {0 1 2 3 4 5 6 7 8 9} \
{
label $f.l$i -text "Hi! I'm the scrolled label $i" -relief groove
pack $f.l$i -padx 10 -pady 2 -anchor nw -fill x
}
label $f.lf -text "Hi! I take up the slack!" -relief groove
pack $f.lf -in $f -padx 10 -pady 2 -anchor nw -fill both -expand 1
======
----
So, how about some examples of using the above package and proc?
For instance, above, under the screenshot, how about showing the code which
created it?
[ulis]: see '''The demo''' & '''Another demo'''
[ZB] Used this scrollable frame in [Tkamixer]
Will this code be going into [tklib]?
[YS] 2011-03-04: Removed using of [format], as it can lead to rare, but serious bug
because of rounding: scrollbar begins to jump back and forth (infinite loop).
[AMG]: A [[see]] subcommand would be most welcome. It would scroll the frame (if necessary) such that a named widget is visible.
[Csaba Nemethi]: The scrollableframe widget of the [Scrollutil] package provides a [[`'''see]]'''` subcommand.
----
**Scrollable frame, another implementation**
[pw] March, 2014
This version is useful when using ttk widgets, as the background is the correct ttk color.
Scrollbars appear or disappear as needed when the frame is resized or the size of the contents changes.
It also handles mousewheel/trackpad scrolling.
======
# sframe.tcl
# Paul Walton
# Create a ttk-compatible, scrollable frame widget.
# Usage:
# sframe new <path> ?-toplevel true? ?-anchor nsew?
# -> <path>
#
# sframe content <path>
# -> <path of child frame where the content should go>
namespace eval ::sframe {
namespace ensemble create
namespace export *
# Create a scrollable frame or window.
proc new {path args} {
# Use the ttk theme's background for the canvas and toplevel
set bg [ttk::style lookup TFrame -background]
if { [ttk::style theme use] eq "aqua" } {
# Use a specific color on the aqua theme as 'ttk::style lookup' is not accurate.
set bg "#e9e9e9"
}
# Create the main frame or toplevel.
if { [dict exists $args -toplevel] && [dict get $args -toplevel] } {
toplevel $path -bg $bg
} else {
ttk::frame $path
}
# Create a scrollable canvas with scrollbars which will always be the same size as the main frame.
set canvas [canvas $path.canvas -bg $bg -bd 0 -highlightthickness 0 -yscrollcommand [list $path.scrolly set] -xscrollcommand [list $path.scrollx set]]
ttk::scrollbar $path.scrolly -orient vertical -command [list $canvas yview]
ttk::scrollbar $path.scrollx -orient horizontal -command [list $canvas xview]
# Create a container frame which will always be the same size as the canvas or content, whichever is greater.
# This allows the child content frame to be properly packed and also is a surefire way to use the proper ttk background.
set container [ttk::frame $canvas.container]
pack propagate $container 0
# Create the content frame. Its size will be determined by its contents. This is useful for determining if the
# scrollbars need to be shown.
set content [ttk::frame $container.content]
# Pack the content frame and place the container as a canvas item.
set anchor "n"
if { [dict exists $args -anchor] } {
set anchor [dict get $args -anchor]
}
pack $content -anchor $anchor
$canvas create window 0 0 -window $container -anchor nw
# Grid the scrollable canvas sans scrollbars within the main frame.
grid $canvas -row 0 -column 0 -sticky nsew
grid rowconfigure $path 0 -weight 1
grid columnconfigure $path 0 -weight 1
# Make adjustments when the sframe is resized or the contents change size.
bind $path.canvas <Expose> [list [namespace current]::resize $path]
# Mousewheel bindings for scrolling.
bind [winfo toplevel $path] <MouseWheel> [list +[namespace current] scroll $path yview %W %D]
bind [winfo toplevel $path] <Shift-MouseWheel> [list +[namespace current] scroll $path xview %W %D]
return $path
}
# Given the toplevel path of an sframe widget, return the path of the child frame suitable for content.
proc content {path} {
return $path.canvas.container.content
}
# Make adjustments when the the sframe is resized or the contents change size.
proc resize {path} {
set canvas $path.canvas
set container $canvas.container
set content $container.content
# Set the size of the container. At a minimum use the same width & height as the canvas.
set width [winfo width $canvas]
set height [winfo height $canvas]
# If the requested width or height of the content frame is greater then use that width or height.
if { [winfo reqwidth $content] > $width } {
set width [winfo reqwidth $content]
}
if { [winfo reqheight $content] > $height } {
set height [winfo reqheight $content]
}
$container configure -width $width -height $height
# Configure the canvas's scroll region to match the height and width of the container.
$canvas configure -scrollregion [list 0 0 $width $height]
# Show or hide the scrollbars as necessary.
# Horizontal scrolling.
if { [winfo reqwidth $content] > [winfo width $canvas] } {
grid $path.scrollx -row 1 -column 0 -sticky ew
} else {
grid forget $path.scrollx
}
# Vertical scrolling.
if { [winfo reqheight $content] > [winfo height $canvas] } {
grid $path.scrolly -row 0 -column 1 -sticky ns
} else {
grid forget $path.scrolly
}
return
}
# Handle mousewheel scrolling.
proc scroll {path view W D} {
if { [winfo exists $path.canvas] && [string match $path.canvas* $W] } {
$path.canvas $view scroll [expr {-$D}] units
}
return
}
}
======
Demonstration
======
# Generate some random content.
for {set row 0} {$row < 100} {incr row} {
for {set col 0} {$col < 100} {incr col} {
append fuzz [string index {abcdefghijklmnopqrstuvwxyz0123456789} [expr {int(rand()*36)}]]
}
append fuzz \n
}
# Use the -toplevel option to create a scrollable toplevel window.
sframe new .demo -toplevel true -anchor w
# Retrieve the path where the scrollable contents go.
set path [sframe content .demo]
# Pack, grid, or place the contents of the scrollable frame.
pack [ttk::label $path.randtext -text $fuzz]
======
[HaO] 2015-02-26: Great work! I had to call 'sframe resize $win' if I resized the contained label by a font size change.
----
'''[tco] - 2016-06-21 08:59:50'''
Great, but impossible to create object with '-toplevel false' ?
object are create but not visible
[EMJ] 2019-08-12: Well, if you run the demonstration with `-toplevel false`, the `.demo` that
is created will be a frame, and there is nowhere for it to be until you pack, grid, or place
it into some toplevel (presumably along with other things). Then you will be able to see it.
<<categories>> Example|GUI|Widget