Updated 2012-09-28 13:07:25 by LkpPo

AJB - I put this together because I'm tired of having to set up the scrollbars, and I don't always want to load packages that have a lot of dependencies. More and more I am interested in packaging Snit with all of my apps, so here is a wrapper for any scrollable widget that will take care of all of your scrollbar woes. PS, not tested on Mac. Sorry.

AJB - Oct 18, 04 - A few changes to incorporate a -scalewidget option based on this [1]. If the option is set to true, the widget uses scales instead of scrollbars.

PAK - Jan 5, 05 - Suppress scrollbar thrashing on text widget when only the last line is too long. When that happens, a horizontal scroll bar is needed, which means the last line gets replaced by the scroll bar, which means that none of the visible lines are too long, which means that the scroll bar gets removed, which means the last line is too long....
 ##########################################
 #
 # snitscrollwindow.tcl
 #   
 #     Package to provide a wrapper around any scrollable widget
 #     i.e. - text, listbox, canvas
 #
 #     The scrollbars should have all of the proper bindings
 #     The scrollbars will auto hide/appear as needed
 #
 #   Options:
 #     -windowtype   --  defaults to canvas, but can be any scrollable widget
 #     -scalewidget  --  boolean option, if set to true scale widgets will be used in
 #                       place of the scrollbars
 #                       these options can only be set at creation time
 #       -- all other options are passed to the internal widget itself
 #       -- scrollbar options can be configured using the xscroll/yscroll methods
 #
 #   Methods:
 #     xscroll --  calling xscroll will cause all remaining args to be sent to the x-scrollbar
 #                 example   $win xscroll configure -width 12
 #       -- all of the usual default snit methods  configure, cget, etc
 #
 #   Results:
 #     calling snit::widget with the path of an empty container widget will provide a -windowtype with
 #     scrollbars that appear and disappear as needed, and that have all of the correct bindings


 package provide snitScrollWindow 0.2
 package require Tk
 package require snit

 snit::widget snitScrollWindow {
  # since this option is configured in the constructor, it should not be set to read-only !
  option -windowtype -default canvas -validatemethod IsScrollableWidget -readonly no
  option -scalewidget -default 0 -validatemethod BooleanOption -readonly yes
  delegate option * to mainWindow
  delegate method * to mainWindow

  variable mainWindow
  variable scrollGrid -array {}
  
  constructor {args} {
    catch {$self configurelist $args}
    set widget [$self cget -windowtype]
    set mainWindow [$widget $win.main]
    $self configure -yscrollcommand [mymethod ScrollHandle $win.y] -xscrollcommand [mymethod ScrollHandle $win.x]
    grid $mainWindow -row 0 -column 0 -sticky nesw
    grid columnconfigure $win 0 -weight 1
    grid rowconfigure $win 0 -weight 1
    if {[$self cget -scalewidget]} {
      scale $win.y -orient vertical -command [mymethod WindowScaleScroll $mainWindow yview] -width 12 -from 0 -to 1000 -show 0
      scale $win.x -orient horizontal -command [mymethod WindowScaleScroll $mainWindow xview] -width 12 -from 0 -to 1000 -show 0
    } else {
      scrollbar $win.y -orient vertical -command [list $self yview] -width 12
      scrollbar $win.x -orient horizontal -command [list $self xview] -width 12
    }
    grid $win.y -row 0 -column 1 -sticky ns
    grid $win.x -row 1 -column 0 -sticky ew
    set scrollGrid($win.y) [grid info $win.y]
    set scrollGrid($win.x) [grid info $win.x]
    if {$widget eq "canvas"} {bind $mainWindow <Expose> {%W configure -scrollregion [%W bbox all]}}
    bind $mainWindow <Button-4> [list $self yview scroll -1 units]
    bind $mainWindow <Button-5> [list $self yview scroll  1 units]
    bind $mainWindow <Shift-Button-4> [list $self xview scroll -1 units]
    bind $mainWindow <Shift-Button-5> [list $self xview scroll  1 units]
    bind $mainWindow <Button> [mymethod HorizScroll %b]
    bind $mainWindow <MouseWheel> {%W yview scroll [expr {int(pow(%D/-120,3))}] units}
    bind $mainWindow <Shift-MouseWheel> {%W xview scroll [expr {int(pow(%D/-120,3))}] units}
    $self configurelist $args
  }
  
  method xscroll {args} {eval {$win.x} $args}
  method yscroll {args} {eval {$win.y} $args}

  method HorizScroll {btn} {
    if {$btn == 6} {
      $mainWindow xview scroll -1 units
    } elseif {$btn == 7} {
      $mainWindow xview scroll 1 units
    }
  }

  variable suppress                      ;#PAK
  method ScrollHandle {w first last} {
    if {[$self cget -scalewidget]} {
      if {[set val [expr 1.0 - ($last - $first)]] > 0.0} {set val [expr int(1000 / $val * $first)]}
      $w set $val
    } else {
      $w set $first $last
    }
    variable suppress                    ;#PAK
    if { ![info exists suppress($w)] } { ;#PAK 
      set suppress($w) 1                 ;#PAK
      if {$first <= 0 && $last >= 1} {
        grid forget $w
      } else {
        eval {grid $w} $scrollGrid($w)
      }
      update                             ;#PAK
      unset suppress($w)                 ;#PAK
    }                                    ;#PAK
  }
  
  method WindowScaleScroll {w axis pos} {
    foreach {first last} [$w $axis] break
    set val [expr 1.0 - ($last - $first)]
    set val [expr ($val / 1000) * $pos]
    $w $axis moveto $val
  }
  
  method BooleanOption {option value} {
    if {$value eq ""} {set value 1}
    if {![string is boolean -strict $value]} {error "expected a boolean values, got \"$value\""}
  }

  method IsScrollableWidget {opt widget args} {
    if {[catch {$widget $win.temp -yscrollcommand {}}]} {error "$widget is not a scrollable widget"}
    destroy $win.temp
  }
 }

And some test code:
 package require snitScrollWindow
 pack [snitScrollWindow .fr] -fill both -expand 1
 .fr create oval 0 0 200 200
 .fr create oval 200 200 300 300
 .fr xscroll configure -width 10 -bg black
 .fr yscroll configure -width 10 -bg black
 toplevel .n
 pack [snitScrollWindow .n.fr -windowtype text -width 15 -wrap none] -fill both -expand 1
 for {set x 0} {$x < 50} {incr x} {.n.fr insert end "This is line number $x \n"}

ABU Take a look at a very similar widget :scanvas ..

AJB Interesting, but it doesn't seem to incorporate all of the various mousewheel bindings, which was part of why I wrote this.... And, it doesn't auto-hide the scrollbars when they are not needed, which is the other part of why I wrote this.

ABU 26-jan-2005

Another new alternative is scrodget. A new generic-scrolled-widget (really close to the BWidgets's ScrolledWindow).