axis scroller

MGS [2003/08/08] - Here's a little script to add buttons to any scrollable widget, instead of using scrollbars (that take up real estate). The buttons only appear when needed. This was inspired by Outlook. Note: This only really works well for scrolling a single axis (x or y), because the x+ and y+ buttons get place'd in the same bottom-right corner.

 # axis.tcl --

 # axis scroller

 # Version   : 0.0.1
 # Author    : Mark G. Saye
 # Email     : [email protected]
 # Copyright : Copyright (C) 2003
 # Date      : August 08, 2003

 # See the file "LICENSE.txt" or "LICENSE.html" for information on usage
 # and distribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 # ======================================================================

 # axis --

 # Description
 #   Create axis-scrolling buttons

 # Arguments
 #   W    : scrollable widget
 #   axis : scrollable axis (x or y)

 # Return
 #   name of scrollable widget W

 proc axis {W axis} {

 # ----------------------------------------------------------------------

   set less $W.${axis}-
   set more $W.${axis}+

 # ----------------------------------------------------------------------

   switch -- $axis {
     x {
       set iless [image create bitmap -data {
         define down_width 9
         define down_height 9
         static unsigned char down_bits[] = {
           0x00,0x00,0x20,0x00,0x30,0x00,0x38,0x00,0x3c,
           0x00,0x38,0x00,0x30,0x00,0x20,0x00,0x00,0x00};
       }]
       set imore [image create bitmap -data {
         define down_width 9
         define down_height 9
         static unsigned char down_bits[] = {
           0x00,0x00,0x08,0x00,0x18,0x00,0x38,0x00,0x78,
           0x00,0x38,0x00,0x18,0x00,0x08,0x00,0x00,0x00};
       }]
     }
     y {
       set iless [image create bitmap -data {
         define down_width 9
         define down_height 9
         static unsigned char down_bits[] = {
           0x00,0x00,0x00,0x00,0x10,0x00,0x38,0x00,0x7c,
           0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0x00,0x00};
       }]
       set imore [image create bitmap -data {
         define down_width 9
         define down_height 9
         static unsigned char down_bits[] = {
           0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0x00,0x7c,
           0x00,0x38,0x00,0x10,0x00,0x00,0x00,0x00,0x00};
       }]
     }
   }

 # ----------------------------------------------------------------------

   button $less \
     -image $iless \
     -highlightthickness 0 \
     -takefocus 0 \
     -command [list $W ${axis}view scroll -1 units]

   button $more \
     -image $imore \
     -highlightthickness 0 \
     -takefocus 0 \
     -command [list $W ${axis}view scroll 1 units]

   catch {$less configure -repeatdelay 300 -repeatinterval 30}
   catch {$more configure -repeatdelay 300 -repeatinterval 30}

   $W configure -${axis}scrollcommand \
     [list [namespace current]::axis:set $W $axis]

   bind $less <Destroy> [list image delete $iless]
   bind $more <Destroy> [list image delete $imore]

 # ----------------------------------------------------------------------

   return $W

 }

 # ======================================================================

 proc axis:set {W axis first last} {

   set less $W.${axis}-
   set more $W.${axis}+

   set w1 [winfo reqwidth  $less]
   set w2 [winfo reqwidth  $more]
   set h1 [winfo reqheight $less]
   set h2 [winfo reqheight $more]

   switch -- $axis {
     x { set a1 sw ; set rx1 0 ; set ry1 1
         set a2 se ; set rx2 1 ; set ry2 1 }
     y { set a1 ne ; set rx1 1 ; set ry1 0
         set a2 se ; set rx2 1 ; set ry2 1 }
   }

   if { $first > 0 } {
     place $less   -relx $rx1 -width  $w1 \
       -anchor $a1 -rely $ry1 -height $h1
     raise $less
   } else {
     place forget $less
   }

   if { $last < 1 } {
     place $more   -relx $rx2 -width  $w2 \
       -anchor $a2 -rely $ry2 -height $h2
     raise $more
   } else {
     place forget $more
   }

 }

 # ======================================================================

   # demo code
   if { [info exists argv0] && [string equal [info script] $argv0] } {
     listbox .listbox -bd 20 -relief sunken

     for {set i 1} {$i <= 20} {incr i} {
       .listbox insert end "$i This is listbox item $i - make it long\
         enough to test horizontal scrolling"
     }
     pack .listbox -side top -expand 1 -fill both -padx 20 -pady 20

     axis .listbox y
   }

 # ======================================================================