diff options
Diffstat (limited to 'library/ttk/utils.tcl')
| -rw-r--r-- | library/ttk/utils.tcl | 36 |
1 files changed, 31 insertions, 5 deletions
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index 1de8ec8..9f3d12d 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -1,5 +1,5 @@ # -# $Id: utils.tcl,v 1.6 2008/01/06 19:16:12 jenglish Exp $ +# $Id: utils.tcl,v 1.7 2008/12/07 21:24:12 jenglish Exp $ # # Utilities for widget implementations. # @@ -251,10 +251,7 @@ proc ttk::copyBindings {from to} { } } -## Standard mousewheel bindings. -# -# Usage: [ttk::copyBindings TtkScrollable $bindtag] -# adds mousewheel support to a scrollable widget. +### Mousewheel bindings. # # Platform inconsistencies: # @@ -278,6 +275,35 @@ proc ttk::copyBindings {from to} { # Gtk+ and Qt do not appear to use as large a factor). # +## ttk::bindMouseWheel $bindtag $command... +# Adds basic mousewheel support to $bindtag. +# $command will be passed one additional argument +# specifying the mousewheel direction (-1: up, +1: down). +# + +proc ttk::bindMouseWheel {bindtag callback} { + switch -- [tk windowingsystem] { + x11 { + bind $bindtag <ButtonPress-4> "$callback -1" + bind $bindtag <ButtonPress-5> "$callback +1" + } + win32 { + bind $bindtag <MouseWheel> [append callback { [expr {-(%D/120)}]}] + } + aqua { + bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ] + } + } +} + +## Mousewheel bindings for standard scrollable widgets. +# +# Usage: [ttk::copyBindings TtkScrollable $bindtag] +# +# $bindtag should be for a widget that supports the +# standard scrollbar protocol. +# + switch -- [tk windowingsystem] { x11 { bind TtkScrollable <ButtonPress-4> { %W yview scroll -5 units } |