[GPS] @ April 25 2003 - For my [SDynObject] project I wrote a scrolled frame widget in order to demonstrate how easy it's to use SDynObject. The code below creates this image: [http://www.xmission.com/~georgeps/SDynObject/scrolled.frame.png] SDynObject is available under the terms of a license similar to Tcl. You can download it and this demo here: http://www.xmission.com/~georgeps/SDynObject [LV] 2009-Jul-14 Anyone know the current URL for SDynObject and demos ? [hae] 2009-Jul-14 See http://wiki.tcl.tk/6196 for a version of the SDynObject code. ---- ====== source ./SDynObject.tcl proc scrolled.frame {win childWinPtr args} { upvar $childWinPtr childWin set obj [sd.new.object] if {[llength $args] & 1} { return -code error "bad number of arguments; uneven number: $args" } set options(-xscrollcommand) "" set options(-yscrollcommand) "" set options(-width) 200 set options(-height) 200 array set options $args foreach item [list -xscrollcommand -yscrollcommand -width -height] { $obj $item [set options($item)] unset options($item) } if {[array size options] > 0} { return -code error "invalid argument(s) to $win: [array get options]" } $obj didInitialConfigure 0 sd.new.method update.xview.scrollbar for $obj takes args { uplevel #0 [$self -xscrollcommand] $args } sd.new.method update.yview.scrollbar for $obj takes args { uplevel #0 [$self -yscrollcommand] $args } sd.new.method event.configure for $obj takes {win frameWin width height} { set halfWidth [expr {$width / 2}] set halfHeight [expr {$height / 2}] $win.c configure -scrollregion [list -$halfWidth -$halfHeight $halfWidth $halfHeight] if {0 == [$self didInitialConfigure]} { $win.c xview moveto 0 $win.c yview moveto 0 after idle [list $self didInitialConfigure 1] } } sd.new.method instance.handler for $obj takes {win args} { if {[llength $args] < 3} { return -code error "invalid number of arguments sent to $win" } set subCmd [lindex $args 0] if {"xview" == $subCmd} { uplevel #0 $win.c $args } elseif {"yview" == $subCmd} { uplevel #0 $win.c $args } else { return -code error "invalid subcommand sent to $win: $subCmd" } } frame $win canvas $win.c -xscrollcommand [$obj update.xview.scrollbar] \ -yscrollcommand [$obj update.yview.scrollbar] pack $win.c -fill both -expand 1 frame $win.c.f bind $win.c.f [list [$obj event.configure] $win %W %w %h] $obj frameId [$win.c create window 0 0 -window $win.c.f] set childWin $win.c.f rename $win _orig$win interp alias {} $win {} [$obj instance.handler] $win return $win } #BEGIN DEMO proc add.more childWin { if {[winfo exists $childWin.l0]} { return } for {set i 0} {$i < 50} {incr i} { pack [label $childWin.l$i -text "Label $i"] } } proc main {} { pack [frame .fm] -fill both -expand 1 scrollbar .fm.xscroll -orient horizontal -command [list .fm.sf xview] scrollbar .fm.yscroll -command [list .fm.sf yview] scrolled.frame .fm.sf childWin -xscrollcommand [list .fm.xscroll set] \ -yscrollcommand [list .fm.yscroll set] grid .fm.xscroll -row 1 -column 0 -sticky we grid .fm.yscroll -row 0 -column 1 -sticky ns grid .fm.sf -row 0 -column 0 -sticky news grid rowconfigure .fm 0 -weight 1 grid columnconfigure .fm 0 -weight 1 for {set y 0} {$y < 40} {incr y} { pack [frame $childWin.f$y] -fill x for {set x 0} {$x < 20} {incr x} { pack [button $childWin.f$y.$x -text "$x $y"] -side left } } pack [button .b -text {Add More} -command [list add.more $childWin]] } main ====== ---- '''See also''' * [A scrolled frame] * [scrolledframe] <> GUI | Widget