**Virtual Scrolling** Last Update: 2016-10-24 [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 very 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 basic scrolling areas, 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 example ('testsd3.tcl'). The 'grid forget' command is used to avoid slowness associated with destroying and creating new widgets. This requires some extra widget management. The code handles multiple scrolling regions in a single window. Row 0 is left available for a heading line (which is not scrolled). 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. [bll] 2016-10-24 Rewrote to be an object. A little easier to use now, but the API can still use some work and cleanup. [moi] 2016-10-25 Not good my man. It sounds good but to bad I cant try it. it says tcl/Tk 8.6 needs it. [bll] 2016-10-25 Actually it needs 8.5 (for {*}), so that's a mistake. [moi] 2016-10-26 I travel today without my desktop. On my laptop, it says invalid command ::oo::class. I belive errors is here. It wants verson 8.6. Not so? -- It even works with a million entries (just change the number in 'test2.tcl'), which are built up within two seconds. Really good performance! [HolgerJ], 2015-12-27 scrolldata.tcl: ====== #!/usr/bin/tclsh # # Copyright 2015-2016 Brad Lanam Walnut Creek CA USA # MIT License # package require Tk 8.5 package require platform package provide scrolldata 2.0 ::oo::class create scrolldata { constructor { win sb confcallback popcallback displaymax {rowmult 1} } { my variable sdvars my variable sdslaves my variable sdslheight set genplat [platform::generic] set sdvars(os.windows) false set sdvars(os.macosx) false if { [regexp -nocase {^win} $genplat] } { set sdvars(os.windows) true } if { $::tcl_platform(os) eq "Darwin" } { set sdvars(os.macosx) true } set sdvars(window) $win set sdvars(window.sb) $sb set sdvars(conf.callback) $confcallback set sdvars(pop.callback) $popcallback set sdvars(dispmax) $displaymax set sdvars(listoffset) 0 set sdvars(resize.afterid) {} set sdvars(first) 1 set sdvars(first.resize) 1 set sdvars(indisplay) 0 set sdvars(inresize) 0 set sdvars(scroll.afterid) {} set sdvars(mapped) 0 set sdvars(rowmult) $rowmult ; # how many rows of data per line set sdvars(sp.afterid) {} set sdvars(binds.done) false # This is the default. # Done here as it makes the construction # of the scrolldata object easier for the user. # This can of course be overridden by the user. $sdvars(window.sb) configure -command [list [self] scroll] bind $sdvars(window) +[list [self] sd_domap $sdvars(window)] bind $sdvars(window.sb) +[list [self] sd_domap $sdvars(window.sb)] # no telling where the focus is in relation to the pointer, # so must bind to all. bind all +[list [self] pageHandler -1] bind all +[list [self] pageHandler 1] bind all <> +[list [self] arrowHandler -1] bind all <> +[list [self] arrowHandler 1] } method setScrollbar { } { my variable sdvars if { $sdvars(max) > 0 } { set l [expr {double($sdvars(listoffset))/double($sdvars(max))}] set h [expr {double($sdvars(listoffset)+$sdvars(dispmax)) / \ double($sdvars(max))}] } else { set l 0.0 set h 1.0 } $sdvars(window.sb) set $l $h $sdvars(window.sb) set $l $h } method sd_scroll { } { my variable sdvars if { ! [winfo exists $sdvars(window)] } { return } set sdvars(scroll.afterid) {} # generate the leave and enter events for whatever's under the mouse pointer lassign [winfo pointerxy $sdvars(window)] x y set tw [winfo containing $x $y] if { $tw ne $sdvars(window) && $tw ne $sdvars(window.sb) } { event generate $tw } my display $sdvars(max) $sdvars(listoffset) if { $tw ne $sdvars(window) && $tw ne $sdvars(window.sb) } { event generate $tw } } method scroll { args } { my variable sdvars if { [llength $args] == 0 } { return } if { ! [info exists sdvars(max)] } { return } lassign $args cmd val type set rm $sdvars(rowmult) if { $cmd eq "scroll" && $type eq "pages" } { set offset [expr {(($sdvars(listoffset)+($val*$sdvars(dispmax)))/$rm)*$rm}] } if { $cmd eq "scroll" && $type eq "units" } { set offset [expr {$sdvars(listoffset)+($val*$rm)}] } if { $cmd eq "moveto" } { set offset [expr {int(floor(double($sdvars(max))*double($val)))/$rm*$rm}] } if { $offset > [expr {$sdvars(max)-$sdvars(dispmax)}] } { set offset [expr {$sdvars(max)-$sdvars(dispmax)}] } if { $offset < 0 } { set offset 0 } set sdvars(listoffset) $offset my setScrollbar if { $cmd eq "moveto" } { if { $sdvars(scroll.afterid) ne {} } { after cancel $sdvars(scroll.afterid) } set sdvars(scroll.afterid) [after 1 [list [self] sd_scroll]] } else { my sd_scroll } } method scrollUnit { dir } { my setScrollbar my scroll scroll $dir units } method chkScroll { didx } { my variable sdvars set rc 0 if { ! [info exists sdvars(max)] } { return $rc } my setScrollbar if { $sdvars(max) == 0 } { return $rc } set didx [expr {$didx*$sdvars(rowmult)}] set max [expr {double($sdvars(max))}] set val [expr {double($didx)/$max}] set low [expr {double($sdvars(listoffset))/$max}] set high [expr {double(($sdvars(listoffset)+$sdvars(dispmax)-1))/$max}] if { $val < $low || $val > $high } { my scroll moveto $val set rc 1 } return $rc } method getdispmax { } { my variable sdvars return $sdvars(dispmax) } method sd_domap { wvar } { my variable sdvars incr sdvars(mapped) ### # could bindtags be used?...don't want to destroy # any user level bindings. bind $wvar {} } method resize { {nw 0} {nh 0} } { my variable sdvars if { $sdvars(first) } { return } if { $sdvars(mapped) != 2 } { return } if { $sdvars(inresize) } { return } if { $sdvars(indisplay) } { return } if { $sdvars(resize.afterid) ne {} } { after cancel $sdvars(resize.afterid) } set sdvars(resize.afterid) \ [after 50 [list [self] sd_resize]] } method sd_resize { } { my variable sdvars my variable sdslaves my variable sdslheight if { ! [winfo exists $sdvars(window)] } { return } if { ! [winfo exists $sdvars(window.sb)] } { return } if { $sdvars(inresize) } { return } set sdvars(inresize) 1 set odm $sdvars(dispmax) set h1 [winfo reqheight $sdvars(window)] set h2 [winfo height $sdvars(window)] set h $h2 if { $h1 > $h2 } { set h [expr {min($h1,$h2)}] } if { $h1 < $h2 } { set h [expr {max($h1,$h2)}] } set c 0 lassign [grid bbox $sdvars(window) 0 0 4 0] x y hw hh set currh 0 for { set r 1 } { $r <= $sdvars(dispmax) } { incr r } { if { $sdvars(first.resize) } { set rh 0 foreach {sw} $sdslaves($r) { set rh [expr {max($rh,[my _getSlaveHeight $sw $r])}] } set sdslheight($r) $rh } else { set rh $sdslheight($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 sdvars(first.resize) 0 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(dispmax) $r if { $r != $odm || $r == 0 } { if { ($sdvars(max)-$sdvars(dispmax)) < $sdvars(listoffset) } { set sdvars(listoffset) \ [expr {$sdvars(max)-$sdvars(dispmax)}] if { $sdvars(listoffset) < 0 } { set sdvars(listoffset) 0 } } my display $sdvars(max) $sdvars(listoffset) } set sdvars(resize.afterid) {} set sdvars(inresize) 0 } method reconfigure { r dataidx } { my variable sdslaves grid forget {*}$sdslaves($r) my _confRow $r $dataidx return $sdslaves($r) } method reconfigureAll { dataidx } { my variable sdvars my variable sdslaves for { set r 1 } { $r <= $sdvars(dispmax) } { incr r } { if { ! [info exists sdslaves($r)] } { break } grid forget {*}$sdslaves($r) my _confRow $r $dataidx incr dataidx } } method sd_stopPropagation { } { my variable sdvars if { ! $sdvars(first) } { return } if { $sdvars(mapped) != 2 } { after cancel $sdvars(sp.afterid) set vars(sp.afterid) [after 50 \ [list [self] sd_stopPropagation]] return } set sdvars(indisplay) 0 if { $sdvars(first) && [winfo exists $sdvars(window)] } { grid propagate $sdvars(window) off set sdvars(first) 0 } # this seems to work, after idle does not. after 100 [list [self] sd_resize] } method _resetBinding { s } { set bt [bindtags $s] set idx [lsearch -exact $bt all] set bt [lreplace $bt $idx $idx] set bt [linsert $bt 0 all] bindtags $s $bt } method _confRow { r dataidx } { my variable sdslaves my variable sdvars my variable sdslheight set sdslaves($r) [$sdvars(conf.callback) $sdvars(window) $r $dataidx] set rh 0 foreach {s} $sdslaves($r) { if { [winfo class $s] eq "TCombobox" } { my _resetBinding $s set popdown [ttk::combobox::PopdownWindow $s] my _resetBinding $popdown } set rh [expr {max($rh,[my _getSlaveHeight $s $r])}] } set sdslheight($r) $rh } method _getSlaveHeight { s r } { my 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])}] } # the assumption here is that the second row will be the # same height as the first. set rh [expr {$rh*$sdvars(rowmult)}] } return $rh } method _chkOffset { dmax offset dispmax } { if { $dmax - $offset + 1 < $dispmax } { set offset [expr {$dmax - $dispmax}] if { $offset < 0 } { set offset 0 } } return $offset } method display { dmax {offset {}} } { my variable sdvars my variable sdslaves my variable sdslheight if { ! [winfo exists $sdvars(window)] } { return } set sdvars(indisplay) 1 if { $offset eq {} } { set offset $sdvars(listoffset) } # removal of an item should not shrink the screen... if { $offset > 0 && [info exists sdvars(max)] && $dmax + 1 == $sdvars(max) && $offset + $sdvars(dispmax) == $sdvars(max) } { incr offset -1 } set offset [my _chkOffset $dmax $offset $sdvars(dispmax)] set r 1 set sdvars(max) $dmax set dataidx $offset set maxh [winfo height $sdvars(window)] lassign [grid bbox $sdvars(window) 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(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($r)] } { my _confRow $r $dataidx } set rh $sdslheight($r) incr currh $rh $sdvars(pop.callback) $sdvars(window) $r $dataidx $sdslaves($r) if { $maxh == 1 && $r >= $sdvars(dispmax) } { break } incr r 1 incr dataidx } if { $maxh != 1 || $dataidx >= $sdvars(max) } { incr r -1 } set r [expr {$r/$sdvars(rowmult)*$sdvars(rowmult)}] set sdvars(dispmax) $r set offset [my _chkOffset $dmax $offset $sdvars(dispmax)] set sdvars(listoffset) $offset # remove the grid items larger than the display set r [expr {$sdvars(dispmax)+1}] while { [info exists sdslaves($r)] } { # don't use remove here, as windows does really weird resizing thingies. grid forget {*}$sdslaves($r) unset sdslaves($r) unset sdslheight($r) incr r } my setScrollbar # 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 if { $sdvars(first) } { after cancel $sdvars(sp.afterid) set sdvars(sp.afterid) [after idle \ [list [self] sd_stopPropagation]] } else { set sdvars(indisplay) 0 } } method curroffset { } { my variable sdvars return $sdvars(listoffset) } method reconfWidget { slv s cmd } { upvar $slv sl if { [winfo exists $s] } { lappend sl $s } else { lappend sl [{*}$cmd] } } method windowCheck { wz } { my variable sdvars if { $wz ne $sdvars(window) && [winfo parent $wz] ne $sdvars(window) && [winfo parent [winfo parent $wz]] ne $sdvars(window) } { return true } return false } method pageHandler { d } { variable sdvars if { ! [winfo exists $sdvars(window)] } { return -code ok } lassign [winfo pointerxy $sdvars(window)] x y set wz [winfo containing $x $y] if { [winfo class $wz] eq "TCombobox" } { return -code ok } if { [my windowCheck $wz] } { return -code ok } my scroll scroll $d pages return -code break } method arrowHandler { d } { variable sdvars if { ! [winfo exists $sdvars(window)] } { return -code ok } lassign [winfo pointerxy $sdvars(window)] x y set wz [winfo containing $x $y] if { ! [winfo exists $wz] } { return -code ok } if { [winfo class $wz] eq "TCombobox" } { return -code ok } if { [my windowCheck $wz] } { return -code ok } my scroll scroll $d units return -code break } method wheelHandler { wz d } { my variable sdvars if { [winfo class $wz] eq "TCombobox" } { return } if { [my windowCheck $wz] } { return } if { $sdvars(os.windows) } { set d [expr {int(-$d / 120)}] } if { $sdvars(os.macosx) } { set d [expr {int(-$d)}] } my scroll scroll $d units return } # not automatically bound as some scrolling areas have specific areas # where the wheel use is allowed. method bindWheel { p } { my variable sdvars bind all +[list {*}$p %W %D] if { ! $sdvars(os.windows) } { bind all +[list {*}$p %W -1] bind all +[list {*}$p %W 1] } } } ====== testsd3.tcl ====== #!/usr/bin/tclsh # # This code is in the public domain. # Originally written by Brad Lanam 2014-08-23 package require Tk 8.5 set ap [file join [file dirname [info script]] ../code] if { $ap ni $::auto_path } { lappend ::auto_path $ap } unset ap 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)] } { $vars(sd$w) reconfWidget sl $w.l$r \ [list ttk::label $w.l$r -width 5] $vars(sd$w) reconfWidget sl $w.e$r \ [list ttk::entry $w.e$r -width 10] grid {*}$sl -in $w -row $r -padx 5 -sticky w } else { $vars(sd$w) reconfWidget sl $w.h$r \ [list ttk::label $w.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 [$vars(sd$w) reconfigure $r $didx] lassign $winlist lab ent } $lab configure -text $vars($didx) $ent configure -textvariable vars($didx) } else { if { $c == 2 } { set winlist [$vars(sd$w) reconfigure $r $didx] lassign $winlist lab } $lab configure -text $vars($didx) } } set maxdisp 20 set max 100 set col 0 foreach {f} [list .l .r] { ttk::frame $f set lab [string trim $f .] set sbnm .sb$lab ttk::scrollbar $sbnm -style Vertical.TScrollbar -orient vertical grid $sbnm -in . -sticky ns -row 0 -column [expr {$col*2+1}] ttk::label .h1$lab -text Label ttk::label .h2$lab -text Entry grid .h1$lab .h2$lab -in $f -row 0 # do this last so it shrinks first grid $f -in . -row 0 -column [expr {$col*2}] -sticky news grid columnconfigure . [expr {$col*2}] -weight 1 grid rowconfigure . 0 -weight 1 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 set vars(sd$f) [scrolldata new $f $sbnm configureLine populateLine $maxdisp] $vars(sd$f) display $max bind $f [list $vars(sd$f) resize %w %h] $vars(sd$f) bindWheel [list $vars(sd$f) wheelHandler] incr col } ====== testrowmultiplier.tcl ====== #!/usr/bin/tclsh # # This code is in the public domain. # Originally written by Brad Lanam 2015-08-19 package require Tk 8.5 set ap [file join [file dirname [info script]] ../code] if { $ap ni $::auto_path } { lappend ::auto_path $ap } unset ap source scrolldata.tcl variable vars proc configureLine { w r didx } { variable vars if { $r % 2 == 1 } { $vars(sd) reconfWidget sl $w.l$r \ [list ttk::label $w.l$r -width 5] grid {*}$sl -in $w -row $r -padx 5 -sticky w -column 0 } else { $vars(sd) reconfWidget sl $w.e$r \ [list ttk::entry $w.e$r -width 10] grid {*}$sl -in $w -row $r -padx 5 -sticky w -column 1 } return $sl } proc populateLine { w r didx winlist } { variable vars lassign $winlist s set idx [expr {$didx/2}] if { $r % 2 == 1 } { $s configure -text $vars($idx) } else { $s configure -textvariable vars($idx) } } set maxdisp 20 set max 98 ttk::frame .f ttk::scrollbar .sb -style Vertical.TScrollbar -orient vertical grid .sb -in . -sticky ns -column 1 -row 0 set vars(sd) [scrolldata new .f .sb configureLine populateLine $maxdisp 2] 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 for { set i 0 } { $i < $max } { incr i } { set vars($i) $i } $vars(sd) display [expr {$max*2}] bind .f [list $vars(sd) resize %w %h] $vars(sd) bindWheel [list $vars(sd) wheelHandler] ====== ---- [bll] 2016-10-24 Various bugfixes. Removed autoscroll. Rewrote to be an object. [bll] 2016-5-1 Fix resize. Added autoscroll capability. [bll] 2016-3-3 Generate Leave and Enter events for whatever widget is under the mouse pointer. [bll] 2016-2-26 Use max of height,reqheight on resize. [bll] 2016-2-21 Use reqheight on a resize. [bll] 2016-2-16 Simplified and fixed chkScroll. [bll] 2016-1-18 Fixed a problem with propagation being turned off too early. [bll] 2015-10-19 Added a check for window existence. [bll] 2015-10-13 Fixes for arrow key handling in conjunction with comboboxes. [bll] 2015-08-19 Update with fixes for row multiplier and test script for row multiplier. Additional helper routines. [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