**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
#
# This code is in the public domain.
# Originally written by Brad Lanam 2014-8-23.

package provide scrolldata 1.0

package require platform

namespace eval scrolldata {
  variable sdvars
  variable sdslaves
  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 <Map> {}
  }

  proc resize { w sb } {
    variable sdvars

    if { $sdvars($w.first) } {
      return
    }
    if { $sdvars($w.mapped) != 2 } {
      return
    }

    if { ! [info exists sdvars($w.dispcount)] } {
      return
    }

    if { $sdvars($w.inresize) } {
      after 20 ::scrolldata::resize $w $sb
      return
    }
    set sdvars($w.inresize) 1
    if { ! [info exists sdvars($w.dispheight)] } {
      set h [winfo height $w]
      # The +10 helps to prevent issues with mixes of different height lines
      # and then switching to all the taller versions.
      # As these windows don't have a pre-designated height,
      # dispcount has the actual number of rows displayed...
      set sdvars($w.dispheight) [expr {double($h+10) / \
          double($sdvars($w.dispcount))}]
    }
    set odm $sdvars($w.dispmax)
    set h [winfo height $w]
    set m [expr {int($h/$sdvars($w.dispheight))}]
    set sdvars($w.dispmax) $m
    if { $m != $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.inresize) 0
  }

  proc reconfigure { w r dataidx } {
    variable sdslaves
    variable sdvars

    grid forget {*}$sdslaves($w.$r)
    set sdslaves($w.$r) [$sdvars($w.confcallback) $w $r $dataidx]
    return $sdslaves($w.$r)
  }

  proc _stopPropagation { w } {
    if { [winfo exists $w] } {
      grid propagate $w off
    }
  }

  proc display { w sb offset dmax } {
    variable sdvars
    variable sdslaves

    set sdvars($w.dispcount) 1 ; # leave room for header

    set r $sdvars($w.dispcount)
    set sdvars($w.max) $dmax

    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
    while { $r <= $sdvars($w.dispmax) && $dataidx < $sdvars($w.max) } {
      if { ! [info exists sdslaves($w.$r)] || $sdslaves($w.$r) == {} } {
        set sdslaves($w.$r) [$sdvars($w.confcallback) $w $r $dataidx]
      }
      $sdvars($w.popcallback) $w $r $dataidx $sdslaves($w.$r)
      incr r
      incr dataidx
    }
    set sdvars($w.dispcount) $r

    # remove the grid items larger than the display
    set r $sdvars($w.dispcount)
    while { [info exists sdslaves($w.$r)] } {
      destroy {*}$sdslaves($w.$r)
      unset sdslaves($w.$r)
      incr r
    }

    setScrollbar $w $sb
    set sdvars($w.first) 0
    # after the first display, don't propagate changes any more
    after idle "::scrolldata::_stopPropagation $w"
  }

  proc curroffset { w } {
    variable sdvars

    return $sdvars($w.listoffset)
  }

  proc init { w sb confcallback popcallback displaymax } {
    variable sdvars
    variable sdslaves

    # 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)
      }
    }
    set sdvars($w.confcallback) $confcallback
    set sdvars($w.popcallback) $popcallback
    set sdvars($w.dispmax) $displaymax
    set sdvars($w.listoffset) 0
    set sdvars($w.inresize) 0
    set sdvars($w.first) 1
    set sdvars($w.scrollafterid) {}
    set sdvars($w.mapped) 0
    bind $w <Map> "::scrolldata::_domap $w $w"
    bind $sb <Map> "::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 <MouseWheel> "+$p %W $w $sb %D"
    if { ! [regexp -nocase {^win} $genplat] } {
      bind all <Button-4> "+$p %W $w $sb -1"
      bind all <Button-5> "+$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

  lappend sl [ttk::label .f.l$r -width 5]
  lappend sl [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 . <Configure> {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 . <Configure> {scrolldata::resize .f .sb}
scrolldata::bindWheel .f .sb scrolldata::wheelHandler
======

----

[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].

<<categories>> Widget | Tk