mingw/lib/tk8.5/ttk/scrollbar.tcl

   1 #
   2 # $Id: scrollbar.tcl,v 1.4 2007/12/13 15:27:08 dgp Exp $
   3 #
   4 # Bindings for TScrollbar widget
   5 #
   6
   7 # Still don't have a working ttk::scrollbar under OSX -
   8 # Swap in a [tk::scrollbar] on that platform,
   9 # unless user specifies -class or -style.
  10 #
  11 if {[tk windowingsystem] eq "aqua"} {
  12     rename ::ttk::scrollbar ::ttk::_scrollbar
  13     proc ttk::scrollbar {w args} {
  14         set constructor ::tk::scrollbar
  15         foreach {option _} $args {
  16             if {$option eq "-class" || $option eq "-style"} {
  17                 set constructor ::ttk::_scrollbar
  18                 break
  19             }
  20         }
  21         return [$constructor $w {*}$args]
  22     }
  23 }
  24
  25 namespace eval ttk::scrollbar {
  26     variable State
  27     # State(xPress)     --
  28     # State(yPress)     -- initial position of mouse at start of drag.
  29     # State(first)      -- value of -first at start of drag.
  30 }
  31
  32 bind TScrollbar <ButtonPress-1>         { ttk::scrollbar::Press %W %x %y }
  33 bind TScrollbar <B1-Motion>             { ttk::scrollbar::Drag %W %x %y }
  34 bind TScrollbar <ButtonRelease-1>       { ttk::scrollbar::Release %W %x %y }
  35
  36 bind TScrollbar <ButtonPress-2>         { ttk::scrollbar::Jump %W %x %y }
  37 bind TScrollbar <B2-Motion>             { ttk::scrollbar::Drag %W %x %y }
  38 bind TScrollbar <ButtonRelease-2>       { ttk::scrollbar::Release %W %x %y }
  39
  40 proc ttk::scrollbar::Scroll {w n units} {
  41     set cmd [$w cget -command]
  42     if {$cmd ne ""} {
  43         uplevel #0 $cmd scroll $n $units
  44     }
  45 }
  46
  47 proc ttk::scrollbar::Moveto {w fraction} {
  48     set cmd [$w cget -command]
  49     if {$cmd ne ""} {
  50         uplevel #0 $cmd moveto $fraction
  51     }
  52 }
  53
  54 proc ttk::scrollbar::Press {w x y} {
  55     variable State
  56
  57     set State(xPress) $x
  58     set State(yPress) $y
  59
  60     switch -glob -- [$w identify $x $y] {
  61         *uparrow -
  62         *leftarrow {
  63             ttk::Repeatedly Scroll $w -1 units
  64         }
  65         *downarrow -
  66         *rightarrow {
  67             ttk::Repeatedly Scroll $w  1 units
  68         }
  69         *thumb {
  70             set State(first) [lindex [$w get] 0]
  71         }
  72         *trough {
  73             set f [$w fraction $x $y]
  74             if {$f < [lindex [$w get] 0]} {
  75                 # Clicked in upper/left trough
  76                 ttk::Repeatedly Scroll $w -1 pages
  77             } elseif {$f > [lindex [$w get] 1]} {
  78                 # Clicked in lower/right trough
  79                 ttk::Repeatedly Scroll $w 1 pages
  80             } else {
  81                 # Clicked on thumb (???)
  82                 set State(first) [lindex [$w get] 0]
  83             }
  84         }
  85     }
  86 }
  87
  88 proc ttk::scrollbar::Drag {w x y} {
  89     variable State
  90     if {![info exists State(first)]} {
  91         # Initial buttonpress was not on the thumb,
  92         # or something screwy has happened.  In either case, ignore:
  93         return;
  94     }
  95     set xDelta [expr {$x - $State(xPress)}]
  96     set yDelta [expr {$y - $State(yPress)}]
  97     Moveto $w [expr {$State(first) + [$w delta $xDelta $yDelta]}]
  98 }
  99
 100 proc ttk::scrollbar::Release {w x y} {
 101     variable State
 102     unset -nocomplain State(xPress) State(yPress) State(first)
 103     ttk::CancelRepeat
 104 }
 105
 106 # scrollbar::Jump -- ButtonPress-2 binding for scrollbars.
 107 #       Behaves exactly like scrollbar::Press, except that
 108 #       clicking in the trough jumps to the the selected position.
 109 #
 110 proc ttk::scrollbar::Jump {w x y} {
 111     variable State
 112
 113     switch -glob -- [$w identify $x $y] {
 114         *thumb -
 115         *trough {
 116             set State(first) [$w fraction $x $y]
 117             Moveto $w $State(first)
 118             set State(xPress) $x
 119             set State(yPress) $y
 120         }
 121         default {
 122             Press $w $x $y
 123         }
 124     }
 125 }