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

   1 # scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
   2 #
   3 # Bindings for the TScale widget
   4 #
   5 # $Id: scale.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
   6
   7 namespace eval ttk::scale {
   8     variable State
   9     array set State  {
  10         dragging 0
  11     }
  12 }
  13
  14 bind TScale <ButtonPress-1>   { ttk::scale::Press %W %x %y }
  15 bind TScale <B1-Motion>       { ttk::scale::Drag %W %x %y }
  16 bind TScale <ButtonRelease-1> { ttk::scale::Release %W %x %y }
  17
  18 proc ttk::scale::Press {w x y} {
  19     variable State
  20     set State(dragging) 0
  21
  22     switch -glob -- [$w identify $x $y] {
  23         *track -
  24         *trough {
  25             if {[$w get $x $y] <= [$w get]} {
  26                 ttk::Repeatedly Increment $w -1
  27             } else {
  28                 ttk::Repeatedly Increment $w 1
  29             }
  30         }
  31         *slider {
  32             set State(dragging) 1
  33             set State(initial) [$w get]
  34         }
  35     }
  36 }
  37
  38 proc ttk::scale::Drag {w x y} {
  39     variable State
  40     if {$State(dragging)} {
  41         $w set [$w get $x $y]
  42     }
  43 }
  44
  45 proc ttk::scale::Release {w x y} {
  46     variable State
  47     set State(dragging) 0
  48     ttk::CancelRepeat
  49 }
  50
  51 proc ttk::scale::Increment {w delta} {
  52     if {![winfo exists $w]} return
  53     $w set [expr {[$w get] + $delta}]
  54 }