GJS 2012/5/6 The scrolledframe widget creates a scrollable frame, with scrollbar. The frame is centered in the widget. The
frame method returns the name of the frame to use as a parent.
The two available options are
-xscroll and
-yscroll. Their available values are:
- always Scrollbars are always shown
- auto Scrollbars are only shown when needed
- never Scrollbars are never shown
#tkoo/scrolledframe-v0.1.2.tm
package provide tkoo::scrolledframe 0.1.2
package require tkoo
package require tkoo::autoscroll
tkoo::class ::tkoo::scrolledframe {
superclass tkoo::widget
variable pathname widCmd options frame canvas exists
constructor {wid args} {
#check to see if the class already exists
my Exists $wid
set widCmd $wid
set pathname $wid
#options
my Opt add -xscroll xscroll XScroll always {
my variable pathname widCmd options frame canvas
switch -exact -- $value {
always {
if {[winfo exists $pathname]} {
grid $pathname.x -row 1 -column 0 -sticky news
$pathname.x configure -auto 0
}
}
auto {
if {[winfo exists $pathname]} {
grid $pathname.x -row 1 -column 0 -sticky news
$pathname.x configure -auto 1
}
}
never {
if {[winfo exists $pathname]} {
grid forget $pathname.x
$pathname.x configure -auto 0
}
}
default {
error [msgcat::mc "bad xscroll \"%s\": must be always, auto, or never"]
}
}
}
my Opt add -yscroll yscroll YScroll always {
my variable pathname widCmd options frame canvas
switch -exact -- $value {
always {
if {[winfo exists $pathname]} {
grid $pathname.y -row 0 -column 1 -sticky news
$pathname.y configure -auto 0
}
}
auto {
if {[winfo exists $pathname]} {
grid $pathname.y -row 0 -column 1 -sticky news
$pathname.y configure -auto 1
}
}
never {
if {[winfo exists $pathname]} {
grid forget $pathname.y
$pathname.y configure -auto 0
}
}
default {
error [msgcat::mc "bad xscroll \"%s\": must be always, auto, or never"]
}
}
}
#my Opt add -justify justify Justify [list top left] {
# my variable pathname widCmd options frame canvas
#}
#create widgets
ttk::frame $wid -borderwidth 0
canvas $wid.c -xscrollcommand [list $wid.x set] \
-yscrollcommand [list $wid.y set] -borderwidth 0 -relief flat \
-takefocus 0
tkoo::autoscroll $wid.y -command [list $wid.c yview] -auto 0
tkoo::autoscroll $wid.x -command [list $wid.c xview] -orient horizontal -auto 0
ttk::frame $wid.d
#show widgets
set canvas $wid.c
grid $wid.c $wid.y -sticky news -padx 0 -pady 0
grid $wid.x $wid.d -sticky news -padx 0 -pady 0
grid rowconfigure $wid 0 -weight 1
grid columnconfigure $wid 0 -weight 1
#the container frame
set frame $wid.f
ttk::frame $frame -borderwidth 0 -relief flat -takefocus 1
#$wid.c create window 0 0 -anchor nw -window $frame
$wid.c create window 0 0 -window $frame -tags [list frame]
raise $wid.x
raise $wid.y
raise $wid.d
#bindings
bind $frame <Configure> [list $wid resize %w %h]
bind $canvas <Configure> [list $wid resize]
#configure the widget
if {[llength $args]} {
my configure {*}$args
}
next $wid {*}$args
}
method resize {args} {
set w [winfo width $frame]
set h [winfo height $frame]
if {[winfo width $canvas] > $w} {
set w [winfo width $canvas]
}
if {[winfo height $canvas] > $h} {
set h [winfo height $canvas]
}
set x [expr $w / 2]
set y [expr $h / 2]
incr w -4
incr h -4
$canvas configure -scrollregion [list 0 0 $w $h]
$canvas coords frame $x $y
}
method frame {} {
return $frame
}
}
