**Virtual Scrolling** Last Update: 2017-8-29 (version 2.5) [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. <> 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 [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? [bll] 2016-10-26 You are right. I believe the OO package is available as a separate package for version 8.5. You can use the prior version (http://wiki.tcl-lang.org/_/revision?N=40544&V=24), which does not require OO. Though it will not have the fix I am applying right now. The OO version is easier to use. [kpv] 2016-11-02 This reminds me a bit of [Hack-O-Matic]. The original design wanted to draw 32k*8 boxes and was taking too long. I posted a redesign where I just drew as many boxes that filled the screen and had the contents change as you scroll. [bll] 2016-11-2 Yes. Also [Hugelist] and [Virtuallist]. But I did not find those until long after I wrote this package. <> ---- '''Change History''': <> [bll] 2017-8-29 Cleaned up key binding handling. Added two new methods: setPageAdjust: pass this a negative number if you want the page up/down to display an overlap of the data. setReserved: Specify how many lines are reserved at the top. These lines still need to be populated by your populate callback, but this method allows the scrolling routines to know about the reserved lines and adjust the scrolling behaviour appropriately. [bll] 2017-6-30 Fixed to use and events. Fixed to use bindtags so that user defined bindings will not be modified. [bll] 2016-11-11 Fixed an issue for certain display situations. [bll] 2016-11-2 More fixes for re-calculating the row heights for certain situations. [bll] 2016-10-26 Fixed issues calculating the row height (frames in the row do not have their full height set until fully displayed). [bll] 2016-10-24 Various bugfixes. Removed autoscroll. Rewrote to be an object. A little easier to use now, but the API can still use some work and cleanup. [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. <> Also available from: https://gentoo.com/tcl/scrolldata.tcl scrolldata.tcl: ====== #!/usr/bin/tclsh # # Copyright 2015-2017 Brad Lanam Walnut Creek CA USA # # LICENSE # # This library is free software; you can use, modify, and redistribute it # for any purpose, provided that existing copyright notices are retained # in all copies and that this notice is included verbatim in any # distributions. # # This software is distributed WITHOUT ANY WARRANTY; without even the # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. # package require Tk 8.6- package require platform ::oo::class create scrolldata { constructor { win sb confcallback popcallback displaymax {rowmult 1} } { # sdvars: # conf.callback row configuration callback procedure # dispmax current number of rows displayed # display.afterid display after id # disp.reserved how many lines are reserved at the top. # first boolean. true for first time displayed. # indisplay lock for display routine # inresize lock for resize routine # listoffset current position in data # mapped how many windows are currently mapped (0-2) # max the user's display maximum # os.macosx boolean # os.windows boolean # page.adjust normally 0. Can be set to adjust the size # of the page scroll-down. Useful if some overlap # on page up/down is wanted. # pop.callback row populate callback procedure # resize.afterid after id for the resizing procedure # rowmult number of rows for each scroll unit. # the height of each row is assume to be the same. # scroll.afterid after id for scroll moveto call # window the scrollable window # window.sb the scrollbar # row.heights: dictionary # height: integer: height of the row # first: boolean: first time calculated? # recalc a flag to recalculate the row heights once # the main window has a height. # sdslaves: array # list of slave widgets indexed by row my variable sdvars my variable sdslaves 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(display.afterid) {} set sdvars(disp.reserved) 0 set sdvars(listoffset) 0 set sdvars(resize.afterid) {} set sdvars(first) 1 set sdvars(indisplay) 0 set sdvars(inresize) 0 set sdvars(scroll.afterid) {} set sdvars(mapped) 0 set sdvars(page.adjust) 0 set sdvars(rowmult) $rowmult ; # how many rows of data per line set sdvars(row.heights) [dict create] set sdvars(recalc) 0 # 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] set w $sdvars(window) set bt [my sd_addBindTag $w sd_mapped] bind $bt [list [self] sd_domap %W] set w $sdvars(window.sb) set bt [my sd_addBindTag $w sd_mapped] bind $bt [list [self] sd_domap %W] # 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] # prevline and nextline are bound to control-p and control-n # for some themes, so bind up and down also. bind all <> +[list [self] arrowHandler -1] bind all <> +[list [self] arrowHandler 1] bind all +[list [self] arrowHandler -1] bind all +[list [self] arrowHandler 1] } method setPageAdjust { pa } { my variable sdvars set sdvars(page.adjust) $pa } method setReserved { r } { my variable sdvars set sdvars(disp.reserved) $r } # Sets the scrollbar low/high ratios. 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 } # Internal # Redisplays the data using the current offset. # Even though the widget doesn't actually change, the leave and enter # events for the widget are generated, as there may be different data # in the widget. 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 } } # Scrolls the window. # Standard method used by a scrollbar. 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)+$sdvars(page.adjust)-$sdvars(disp.reserved)) ) ) / $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}] set offset [expr {$offset-$sdvars(disp.reserved)}] } 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 } # Check to see if the data index is currently displayed. # if not, scroll the window so that the data index is displayed. 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 $didx set low [expr {$sdvars(listoffset)+$sdvars(disp.reserved)}] set high [expr {$sdvars(listoffset)+$sdvars(dispmax)-1}] if { $val < $low || $val > $high } { set sval [expr {double($val)/$max}] my scroll moveto $sval set rc 1 } return $rc } method fieldRow { didx } { my variable sdvars set rc -1 if { ! [info exists sdvars(max)] } { return $rc } if { $sdvars(max) == 0 } { return $rc } set didx [expr {$didx*$sdvars(rowmult)}] set low $sdvars(listoffset) set high [expr {$sdvars(listoffset)+$sdvars(dispmax)-1}] if { $didx >= $low && $didx <= $high } { set rc [expr {$didx-$sdvars(listoffset)+1}] } return $rc } # Get the current number of rows displayed on screen. method getdispmax { } { my variable sdvars return $sdvars(dispmax) } # Internal # Called when the window and window.sb are mapped. method sd_domap { w } { my variable sdvars incr sdvars(mapped) my sd_removeBindTag $w sd_mapped } # Bind this routine to . # Calls the internal resize after 50 milliseconds. 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 _setRowHeight { r h } { variable sdvars if { [dict exists $sdvars(row.heights) $r first] } { dict set sdvars(row.heights) $r first false } else { dict set sdvars(row.heights) $r first true } dict set sdvars(row.heights) $r height $h } # Internal # The first time through, the widget height is an estimate by the # packing manager. So always calculate the row height a second time. method _getRowHeight { r } { variable sdvars set calc false if { ! [dict exists $sdvars(row.heights) $r] } { set calc true } else { if { [dict get $sdvars(row.heights) $r first] } { set calc true } if { $sdvars(recalc) == 1 } { set calc true } } if { $calc } { set rh [my _calcRowHeight $r] my _setRowHeight $r $rh } set rh [list [dict get $sdvars(row.heights) $r height] \ [dict get $sdvars(row.heights) $r first]] return $rh } # Internal # Does the work to resize the window. # Calculates the number of rows that can be displayed. # If the first time, the max height of the slave windows in each row # needs to be calculated, as the slave heights are not set initially. # If the resize forces the list offset off screen, the list offset # is adjusted so that it stays on screen. method sd_resize { } { my variable sdvars my variable sdslaves 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 } { lassign [my _getRowHeight $r] rh first 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(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 } # Reconfigures a single row. # 'grid forget' all the current slaves for that row # and calls the row configuration callback. method reconfigure { r dataidx } { my variable sdslaves grid forget {*}$sdslaves($r) my _confRow $r $dataidx return $sdslaves($r) } # Force a reconfigure for all rows. # The list offset can be changed. method reconfigureAll { {dataidx {}} } { my variable sdvars my variable sdslaves if { $dataidx eq {} } { set dataidx $sdvars(listoffset) } 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_addBindTag { w tag } { if { [lsearch -exact [bindtags $w] $tag$w] == -1 } { bindtags $w [concat [bindtags $w] $tag$w] } return $tag$w } method sd_removeBindTag { w tag } { set b [bindtags $w] set idx [lsearch -exact $b $tag$w] set b [lreplace $b $idx $idx] bindtags $w $b } # Internal # Let the first display of the window adjust the width and height, # but thereafter, stop all propogation of width and height changes. # This procedure runs after the window is displayed, so it is bound # to the event. method sd_stopPropagation { type } { my variable sdvars if { ! $sdvars(first) } { return } if { $sdvars(mapped) != 2 } { return } # remove the binding my sd_removeBindTag $sdvars(window) sd_initconf set sdvars(indisplay) 0 if { $sdvars(first) && [winfo exists $sdvars(window)] } { grid propagate $sdvars(window) off set sdvars(first) 0 } my sd_resize } # Internal # Reset the bindings on comboboxes so that the 'all' bindings # come first. 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 } # Configure the slaves for a row. # Call the row configuration callback to configure the slaves. # For any combo box in the slave list, reset the bindings. method _confRow { r dataidx } { my variable sdslaves my variable sdvars set sdslaves($r) [$sdvars(conf.callback) $sdvars(window) $r $dataidx] foreach {s} $sdslaves($r) { if { [winfo class $s] eq "TCombobox" } { my _resetBinding $s set popdown [ttk::combobox::PopdownWindow $s] my _resetBinding $popdown } } } # Internal # Get the height of row by calculating the max height of all # of the slave widgets. method _calcRowHeight { r } { variable sdslaves set rh 0 foreach {sw} $sdslaves($r) { set rh [expr {max($rh,[my _calcWidgetHeight $sw $r])}] } return $rh } # Internal # Get the height of a slave widget. # If the widget is a container, look through its children to get # the height. method _calcWidgetHeight { 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 } # Internal # Make sure the offset is in the range of the display maximum. # If not, adjust. method _chkOffset { dmax offset dispmax } { if { $dmax - $offset + 1 < $dispmax } { set offset [expr {$dmax - $dispmax}] if { $offset < 0 } { set offset 0 } } return $offset } # Main display routine. Specify the maximum display wanted. # This routine calls the populate row callback for each row passing # the proper display index. method display { dmax {offset {}} {fromafter {}} } { my variable sdvars my variable sdslaves if { ! [winfo exists $sdvars(window)] } { return } set sdvars(indisplay) 1 after cancel $sdvars(display.afterid) 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 set firstflag false 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 } lassign [my _getRowHeight $r] rh first if { $first } { set firstflag true } 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) 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. # the sd_stopPropagation call also turns off the indisplay flag. if { $sdvars(first) } { set w $sdvars(window) set bt [my sd_addBindTag $w sd_initconf] bind $bt [list [self] sd_stopPropagation c] bind $bt [list [self] sd_stopPropagation v] } else { set sdvars(indisplay) 0 } # The row height calculation may not return the correct height # the first time (as frames only reflect their true height once # they have been fully displayed). # If any row heights are calculated for the first time # call display again to recalculate the row heights. # Also recalculate everything again once the outer frame has a height. # if a prior after-idle display was cancelled, re-schedule it. if { $sdvars(display.afterid) ne {} && $fromafter ne "-after" } { set firstflag true set sdvars(recalc) 0 ; # make sure recalc flag stays intact set sdvars(display.afterid) {} } if { $firstflag || ($maxh != 1 && $sdvars(recalc) == 0) } { incr sdvars(recalc) set sdvars(display.afterid) [after idle \ [list [self] display $sdvars(max) $sdvars(listoffset) -after]] } } # Return the current offset within the display. method curroffset { } { my variable sdvars return $sdvars(listoffset) } # Configures a widget and appends it to the slave list. # If the widget with that name exists already, it is # simply appended to the slave list. # If the widget does not yet exist, $cmd is called and # the widget is appended to the slave list. method reconfWidget { slv s cmd } { upvar $slv sl if { [winfo exists $s] } { lappend sl $s } else { lappend sl [{*}$cmd] } } # Scroll by pages. method pageHandler { d } { variable sdvars if { ! [winfo exists $sdvars(window)] } { return -code ok } set cont [winfo containing {*}[winfo pointerxy $sdvars(window)]] if { [winfo class $cont] eq "TCombobox" } { return -code ok } if { ! [string match $sdvars(window)* $cont] } { return -code ok } my scroll scroll $d pages return -code break } # Scroll by single units. method arrowHandler { d } { variable sdvars if { ! [winfo exists $sdvars(window)] } { return -code ok } set cont [winfo containing {*}[winfo pointerxy $sdvars(window)]] if { ! [winfo exists $cont] } { return -code ok } if { [winfo class $cont] eq "TCombobox" } { return -code ok } if { ! [string match $sdvars(window)* $cont] } { return -code ok } my scroll scroll $d units return -code break } # Adjusts the wheel scroll values for windows and mac os x. method wheelHandler { wz d } { my variable sdvars if { [winfo class $wz] eq "TCombobox" } { return } set cont [winfo containing {*}[winfo pointerxy $sdvars(window)]] if { ! [winfo exists $cont] } { return -code ok } if { ! [string match $sdvars(window)* $cont] } { 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] } } } package provide scrolldata 2.5 ====== 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 ../code/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 if { $r == 1 && [string match {.c*} $w] } { set didx 0 } 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 .c] { 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] if { $f eq ".r" } { $vars(sd$f) setPageAdjust -2 } if { $f eq ".c" } { $vars(sd$f) setReserved 1 } bind .h1$lab [list $vars(sd$f) chkScroll 11] bind .h2$lab [list $vars(sd$f) chkScroll 12] 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] ====== See also: [scrollbar] and [Scrolling widgets without a text or canvas wrapper]. <> Widget | Tk