scale.tcl 2.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394
  1. # scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
  2. #
  3. # Bindings for the TScale widget
  4. namespace eval ttk::scale {
  5. variable State
  6. array set State {
  7. dragging 0
  8. }
  9. }
  10. bind TScale <Button-1> { ttk::scale::Press %W %x %y }
  11. bind TScale <B1-Motion> { ttk::scale::Drag %W %x %y }
  12. bind TScale <ButtonRelease-1> { ttk::scale::Release %W %x %y }
  13. bind TScale <Button-2> { ttk::scale::Jump %W %x %y }
  14. bind TScale <B2-Motion> { ttk::scale::Drag %W %x %y }
  15. bind TScale <ButtonRelease-2> { ttk::scale::Release %W %x %y }
  16. bind TScale <Button-3> { ttk::scale::Jump %W %x %y }
  17. bind TScale <B3-Motion> { ttk::scale::Drag %W %x %y }
  18. bind TScale <ButtonRelease-3> { ttk::scale::Release %W %x %y }
  19. ## Keyboard navigation bindings:
  20. #
  21. bind TScale <<LineStart>> { %W set [%W cget -from] }
  22. bind TScale <<LineEnd>> { %W set [%W cget -to] }
  23. bind TScale <<PrevChar>> { ttk::scale::Increment %W -1 }
  24. bind TScale <<PrevLine>> { ttk::scale::Increment %W -1 }
  25. bind TScale <<NextChar>> { ttk::scale::Increment %W 1 }
  26. bind TScale <<NextLine>> { ttk::scale::Increment %W 1 }
  27. bind TScale <<PrevWord>> { ttk::scale::Increment %W -10 }
  28. bind TScale <<PrevPara>> { ttk::scale::Increment %W -10 }
  29. bind TScale <<NextWord>> { ttk::scale::Increment %W 10 }
  30. bind TScale <<NextPara>> { ttk::scale::Increment %W 10 }
  31. proc ttk::scale::Press {w x y} {
  32. variable State
  33. set State(dragging) 0
  34. switch -glob -- [$w identify $x $y] {
  35. *track -
  36. *trough {
  37. set inc [expr {([$w get $x $y] <= [$w get]) ^ ([$w cget -from] > [$w cget -to]) ? -1 : 1}]
  38. ttk::Repeatedly Increment $w $inc
  39. }
  40. *slider {
  41. set State(dragging) 1
  42. set State(initial) [$w get]
  43. }
  44. }
  45. }
  46. # scale::Jump -- Button-2/3 binding for scale acts like
  47. # Press except that clicking in the trough jumps to the
  48. # clicked position.
  49. proc ttk::scale::Jump {w x y} {
  50. variable State
  51. set State(dragging) 0
  52. switch -glob -- [$w identify $x $y] {
  53. *track -
  54. *trough {
  55. $w set [$w get $x $y]
  56. set State(dragging) 1
  57. set State(initial) [$w get]
  58. }
  59. *slider {
  60. Press $w $x $y
  61. }
  62. }
  63. }
  64. proc ttk::scale::Drag {w x y} {
  65. variable State
  66. if {$State(dragging)} {
  67. $w set [$w get $x $y]
  68. }
  69. }
  70. proc ttk::scale::Release {w x y} {
  71. variable State
  72. set State(dragging) 0
  73. ttk::CancelRepeat
  74. }
  75. proc ttk::scale::Increment {w delta} {
  76. if {![winfo exists $w]} return
  77. if {([$w cget -from] > [$w cget -to])} {
  78. set delta [expr {-$delta}]
  79. }
  80. $w set [expr {[$w get] + $delta}]
  81. }