Version 6 of axis scroller

Updated 2010-05-14 10:23:21 by MGS

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
  }

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