Version 5 of snitScrollWindow

Updated 2004-10-19 03:52:04

AJB - I put this together because Im tired of having to setup the scrollbars, and I dont always want to load packages that have alot 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 [L1 ]. If the option is set to true, the widget uses scales instead of scrollbars.

 ##########################################
 #
 # 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 {
  option -windowtype -default canvas -validatemethod IsScrollableWidget -readonly yes
  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
    }
  }

  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
    }
    if {$first <= 0 && $last >= 1} {
      grid forget $w
    } else {
      eval {grid $w} $scrollGrid($w)
    }
  }

  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 doesnt seem to incorporate all of the various mousewheel bindings, which was part of why I wrote this... And, it doesnt auto-hide the scrollbars when they are not needed. Which is the other part of why I wrote this.