**Virtual Scrolling** [bll] 2014-8-23 This is a virtual scrolling solution that does not use a frame wrapper or canvas wrapper. The scrolling frame and scrolling canvas wrapper solutions are all quite memory intensive, as many rows of widgets are generally created ahead of time. Destroying the rows that are no longer displayed is not a solution, as destroying and creating new widgets is quite slow. My initial try with a scrolling frame solution failed with more than a couple of thousand rows (due to the large amount of memory needed for the widget display), and I had the need to handle more than 30000 rows. The code uses two callbacks, one to configure a row with the widgets, and one to populate the data. Each displayed row's widgets are configured with the configuration callback, and each row is populated with the populate callback. When the region is scrolled, the populated data is changed, and the widgets are left in place. For a simple example such as 'test1.tcl' below, the configure callback is only executed on initialization and when the window is resized. The 'reconfigure' and 'reconfWidget' procedures are used for complex displays (e.g. mixed headings and widgets) as in the second example ('test2.tcl'). For complex displays, the 'grid forget' command is used to avoid slowness associated with destroying and creating new widgets. This requires some extra widget management. Complex displays may have a mix of different line heights, so there's always problems calculating how many lines of data the window can hold. The code handles multiple scrolling regions in a single window. Row 0 is left available for a heading line. Scrolling by dragging (moveto) is sped up by using a short delay before redisplaying. A new set of data can be displayed by simply calling the 'display' procedure again. scrolldata.tcl: ====== #!/usr/bin/tclsh # # Originally written by Brad Lanam 2014 # This code is in the public domain # package provide scrolldata 1.0 package require platform namespace eval scrolldata { variable sdvars variable sdslaves variable sdslheight variable genplat set genplat [platform::generic] proc setScrollbar { w sb } { variable sdvars if { $sdvars($w.max) > 0 } { set l [expr {double($sdvars($w.listoffset))/double($sdvars($w.max))}] set h [expr {double($sdvars($w.listoffset)+$sdvars($w.dispmax)) / \ double($sdvars($w.max))}] } else { set l 0.0 set h 1.0 } $sb set $l $h $sb set $l $h } proc _scroll { w sb } { variable sdvars set sdvars($w.scrollafterid) {} display $w $sb $sdvars($w.listoffset) $sdvars($w.max) } proc scroll { w sb args } { variable sdvars if { $args == {} } { return } if { ! [info exists sdvars($w.max)] } { return } lassign $args cmd val type if { $cmd == "scroll" && $type == "pages" } { set offset [expr {$sdvars($w.listoffset)+($val*$sdvars($w.dispmax))}] } if { $cmd == "scroll" && $type == "units" } { set offset [expr {$sdvars($w.listoffset)+$val}] } if { $cmd == "moveto" } { set offset [expr {round(double($sdvars($w.max))*$val)}] } if { $offset > [expr {$sdvars($w.max)-$sdvars($w.dispmax)}] } { set offset [expr {$sdvars($w.max)-$sdvars($w.dispmax)}] } if { $offset < 0 } { set offset 0 } set sdvars($w.listoffset) $offset setScrollbar $w $sb if { $cmd == "moveto" } { if { $sdvars($w.scrollafterid) != {} } { after cancel $sdvars($w.scrollafterid) } set sdvars($w.scrollafterid) [after 10 scrolldata::_scroll $w $sb] } else { _scroll $w $sb } } proc _domap { w wvar } { variable sdvars incr sdvars($wvar.mapped) bind $w {} } proc resize { w sb {nw 0} {nh 0} } { variable sdvars if { $sdvars($w.first) } { return } if { $sdvars($w.mapped) != 2 } { return } if { $sdvars($w.inresize) } { return } if { $sdvars($w.indisplay) } { return } if { $sdvars($w.resizeafterid) != {} } { after cancel $sdvars($w.resizeafterid) } set sdvars($w.resizeafterid) [after 20 ::scrolldata::_resize $w $sb] } proc _resize { w sb } { variable sdvars variable sdslheight if { ! [winfo exists $w] } { return } set sdvars($w.inresize) 1 set odm $sdvars($w.dispmax) set h [winfo height $w] set c 0 lassign [grid bbox $w 0 0 4 0] x y hw hh set currh 0 for { set r 1 } { $r <= $sdvars($w.dispmax) } { incr r } { set rh $sdslheight($w.$r) incr c incr currh $rh if { ($currh + $hh) > $h } { # this will handle the situation where the window size is smaller... incr c -1 break } } set r $c if { $c > 0 } { set er [expr {int(($h - $hh) / ($currh / $c))}] if { $er > $r && [expr {$currh+$hh+($currh/$c)}] <= $h } { set r $er } } set sdvars($w.dispmax) $r if { $r != $odm } { if { ($sdvars($w.max)-$sdvars($w.dispmax)) < $sdvars($w.listoffset) } { set sdvars($w.listoffset) \ [expr {$sdvars($w.max)-$sdvars($w.dispmax)}] if { $sdvars($w.listoffset) < 0 } { set sdvars($w.listoffset) 0 } } display $w $sb $sdvars($w.listoffset) $sdvars($w.max) } set sdvars($w.resizeafterid) {} set sdvars($w.inresize) 0 } proc reconfigure { w r dataidx } { variable sdslaves variable sdslheight variable sdvars grid forget {*}$sdslaves($w.$r) _confRow $w $r $dataidx return $sdslaves($w.$r) } proc _stopPropagation { w } { variable sdvars set sdvars($w.indisplay) 0 if { $sdvars($w.first) && [winfo exists $w] } { grid propagate $w off set sdvars($w.first) 0 } } proc _confRow { w r dataidx } { variable sdslaves variable sdvars variable sdslheight set sdslaves($w.$r) [$sdvars($w.confcallback) $w $r $dataidx] set rh 0 foreach {s} $sdslaves($w.$r) { set rh [expr {max($rh,[_getSlaveHeight $s $w $r])}] } set sdslheight($w.$r) $rh } proc _getSlaveHeight { s w r } { variable sdvars set rh [winfo reqheight $s] if { $rh == 1 } { # some sort of container...get an estimate foreach {sc} [winfo children $s] { set rh [expr {max($rh,[winfo reqheight $sc])}] } set rh [expr {$rh*$sdvars($w.rowmult)+$sdvars($w.rowadd)}] } return $rh } proc display { w sb offset dmax } { variable sdvars variable sdslaves variable sdslheight set r 1 set sdvars($w.max) $dmax set sdvars($w.indisplay) 1 if { $dmax - $offset + 1 < $sdvars($w.dispmax) } { set offset [expr {$dmax - $sdvars($w.dispmax)}] if { $offset < 0 } { set offset 0 } } set sdvars($w.listoffset) $offset set dataidx $offset set maxh [winfo height $w] lassign [grid bbox $w 0 0 4 0] x y hw hh set currh $hh # if maxh is not 1, the window has a size, # use the actual height of the window. # if maxh is 1, the window hasn't been sized yet, # use the number of rows requested. set rh 0 while { $dataidx < $sdvars($w.max) } { # check height based on height of previous row, so we don't # configure and remove a row. if { $maxh != 1 && [expr {$currh+$rh}] > $maxh } { break } if { ! [info exists sdslaves($w.$r)] } { _confRow $w $r $dataidx } set rh $sdslheight($w.$r) incr currh $rh $sdvars($w.popcallback) $w $r $dataidx $sdslaves($w.$r) if { $maxh == 1 && $r >= $sdvars($w.dispmax) } { break } incr r 1 incr dataidx } if { $maxh != 1 || $dataidx >= $sdvars($w.max) } { incr r -1 } set sdvars($w.dispmax) $r # remove the grid items larger than the display set r [expr {$sdvars($w.dispmax)+1}] while { [info exists sdslaves($w.$r)] } { # don't use remove here, as windows does really weird resizing thingies. grid forget {*}$sdslaves($w.$r) unset sdslaves($w.$r) unset sdslheight($w.$r) incr r } setScrollbar $w $sb # after the first display, don't propagate changes any more # need time for window to display, otherwise resize will mangle it # this also turns off the indisplay flag after 100 "::scrolldata::_stopPropagation $w" } proc curroffset { w } { variable sdvars return $sdvars($w.listoffset) } proc init { w sb confcallback popcallback displaymax {rowmult 1} {rowadd 0} } { variable sdvars variable sdslaves variable sdslheight # on init, need to clean out all the old window information. set pat "^$w." regsub -all {\.} $pat {\\.} pat foreach {k} [array names sdvars] { if { [regexp $pat $k] } { unset sdvars($k) } } foreach {k} [array names sdslaves] { if { [regexp $pat $k] } { unset sdslaves($k) } } foreach {k} [array names sdslheight] { if { [regexp $pat $k] } { unset sdslheight($k) } } set sdvars($w.confcallback) $confcallback set sdvars($w.popcallback) $popcallback set sdvars($w.dispmax) $displaymax set sdvars($w.listoffset) 0 set sdvars($w.resizeafterid) {} set sdvars($w.first) 1 set sdvars($w.indisplay) 0 set sdvars($w.inresize) 0 set sdvars($w.scrollafterid) {} set sdvars($w.mapped) 0 set sdvars($w.rowmult) $rowmult ; # how many rows in containing frame set sdvars($w.rowadd) $rowadd ; # how much to add when estimating bind $w "::scrolldata::_domap $w $w" bind $sb "::scrolldata::_domap $sb $w" } proc reconfWidget { slv w cmd } { upvar $slv sl if { [winfo exists $w ] } { lappend sl $w } else { lappend sl [{*}$cmd] } } proc wheelCheck { wz w } { if { $wz != $w && [winfo parent $wz] != $w && [winfo parent [winfo parent $wz]] != $w } { return true } return false } proc wheelHandler { wz w sb d } { variable genplat if { [winfo class $wz] == "TCombobox" } { return } if { [scrolldata::wheelCheck $wz $w] } { return } if { [regexp -nocase {^win} $genplat] } { set d [expr {int($d / 120)}] } scrolldata::scroll $w $sb scroll $d units } proc bindWheel { w sb p } { variable genplat bind all "+$p %W $w $sb %D" if { ! [regexp -nocase {^win} $genplat] } { bind all "+$p %W $w $sb -1" bind all "+$p %W $w $sb 1" } } } ====== test1.tcl: ====== #!/usr/bin/tclsh # # This code is in the public domain. # Originally written by Brad Lanam 2014 package require Tk 8.5 #package require scrolldata source scrolldata.tcl variable vars proc configureLine { w r didx } { variable vars scrolldata::reconfWidget sl .f.l$r [list ttk::label .f.l$r -width 5] scrolldata::reconfWidget sl .f.e$r [list ttk::entry .f.e$r -width 20] grid {*}$sl -in $w -row $r -padx 5 -sticky w return $sl } proc populateLine { w r didx winlist } { variable vars lassign $winlist lab ent $lab configure -text $didx $ent configure -textvariable vars($didx) } ttk::frame .f ttk::scrollbar .sb -style Vertical.TScrollbar \ -orient vertical -command "scrolldata::scroll .f .sb" grid .sb -in . -sticky ns -column 1 -row 0 ttk::label .h1 -text Label ttk::label .h2 -text Entry grid .h1 .h2 -in .f -row 0 # do this last so it shrinks first grid .f -in . -row 0 -sticky news grid columnconfigure . 0 -weight 1 grid rowconfigure . 0 -weight 1 set maxdisp 20 set max 100 scrolldata::init .f .sb configureLine populateLine $maxdisp for { set i 0 } { $i < $max } { incr i } { set vars($i) $i } scrolldata::display .f .sb \ [scrolldata::curroffset .f] $max bind .f {scrolldata::resize .f .sb} scrolldata::bindWheel .f .sb scrolldata::wheelHandler ====== test2.tcl ====== #!/usr/bin/tclsh # # This code is in the public domain. # Originally written by Brad Lanam 2014-08-23 package require Tk 8.5 #package require scrolldata source scrolldata.tcl variable vars proc configureLine { w r didx } { variable vars # Quick and dirty method to differentiate heading from data. # I wouldn't recommend this for real. if { [regexp {^\d+$} $vars($didx)] } { scrolldata::reconfWidget sl .f.l$r \ [list ttk::label .f.l$r -width 5] scrolldata::reconfWidget sl .f.e$r \ [list ttk::entry .f.e$r -width 10] grid {*}$sl -in $w -row $r -padx 5 -sticky w } else { scrolldata::reconfWidget sl .f.h$r \ [list ttk::label .f.h$r] grid {*}$sl -in $w -row $r -padx 5 -sticky w -columnspan 2 } return $sl } proc populateLine { w r didx winlist } { variable vars lassign $winlist lab ent set c [llength $winlist] if { [regexp {^\d+$} $vars($didx)] } { if { $c == 1 } { set winlist [scrolldata::reconfigure $w $r $didx] lassign $winlist lab ent } $lab configure -text $vars($didx) $ent configure -textvariable vars($didx) } else { if { $c == 2 } { set winlist [scrolldata::reconfigure $w $r $didx] lassign $winlist lab } $lab configure -text $vars($didx) } } ttk::frame .f ttk::scrollbar .sb -style Vertical.TScrollbar \ -orient vertical -command "scrolldata::scroll .f .sb" grid .sb -in . -sticky ns -column 1 -row 0 ttk::label .h1 -text Label ttk::label .h2 -text Entry grid .h1 .h2 -in .f -row 0 # do this last so it shrinks first grid .f -in . -row 0 -sticky news grid columnconfigure . 0 -weight 1 grid rowconfigure . 0 -weight 1 set maxdisp 20 set max 100 scrolldata::init .f .sb configureLine populateLine $maxdisp set c 0 for { set i 0 } { $i < $max } { incr i } { if { [expr {$i%10}] == 0 } { set vars($c) "[expr {int($i/10)*10}] group" incr c } set vars($c) $i incr c } set max $c scrolldata::display .f .sb \ [scrolldata::curroffset .f] $max bind .f {scrolldata::resize .f .sb} scrolldata::bindWheel .f .sb scrolldata::wheelHandler ====== ---- [bll] 2014-11-24 Fixes for strange windows behaviours and bug fixes in height/row comparisons. [bll] 2014-11-21 Rewrite. It now works with windows that are already sized and as the original: do X number of rows for the initial display. Resizing works properly. It is more stable now, but a little bit slower. [bll] 2014-11-20 Updated with changes that disallow the resize function until the first display has finished. Added mouse wheel binding routines. Adjusted test routines to make sure windows were children of the scrolling frame. [bll] 2014-10-4 removed update, added mapped window checks, don't scroll if maximum is not set up yet. See also: [scrollbar] and [Scrolling widgets without a text or canvas wrapper]. <> Widget | Tk