diff options
| author | marc_culler <marc.culler@gmail.com> | 2023-11-19 14:21:41 (GMT) |
|---|---|---|
| committer | marc_culler <marc.culler@gmail.com> | 2023-11-19 14:21:41 (GMT) |
| commit | 295a4dd3fc0ace2082cfc84d80601b6efb7c56c8 (patch) | |
| tree | fd99be35a05c481d3c3df87a6cb28527f044d1dc /library | |
| parent | 6985b2c91a0a68e768f0c27a7e21e38fcb657fba (diff) | |
| download | tk-295a4dd3fc0ace2082cfc84d80601b6efb7c56c8.zip tk-295a4dd3fc0ace2082cfc84d80601b6efb7c56c8.tar.gz tk-295a4dd3fc0ace2082cfc84d80601b6efb7c56c8.tar.bz2 | |
Fix Scrollbar bindings
Diffstat (limited to 'library')
| -rw-r--r-- | library/demos/cscroll.tcl | 19 | ||||
| -rw-r--r-- | library/scrlbar.tcl | 46 |
2 files changed, 56 insertions, 9 deletions
diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 41f6d5d..54d98e0 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -27,6 +27,25 @@ pack $btns -side bottom -fill x frame $w.grid ttk::scrollbar $w.hscroll -orient horizontal -command "$c xview" ttk::scrollbar $w.vscroll -command "$c yview" +# Override the scrollbar's mousewheel binding to speed it up: +set fastwheel { + set HiresScrollMask 512 + set ShiftMask 1 + if {[expr {%s & $ShiftMask}]} { + set orientation "h"; + } else { + set orientation "v"; + } + if {[expr {%s & $HiresScrollMask}]} { + tk::ScrollByUnits %W $orientation %D -1.0 + } else { + tk::ScrollByUnits %W $orientation %D -30.0 + } + break +} +bind $w.vscroll <MouseWheel> $fastwheel +bind $w.hscroll <MouseWheel> $fastwheel + canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \ -xscrollcommand "$w.hscroll set" \ -yscrollcommand "$w.vscroll set" diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index c18d4a8..c54e880 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -129,11 +129,31 @@ bind Scrollbar <<LineEnd>> { } } +set HiresScrollMask 512 +set ShiftMask 1 bind Scrollbar <MouseWheel> { - tk::ScrollByUnits %W hv %D -40.0 + if {[expr {%s & $ShiftMask}]} { + set orientation "h"; + } else { + set orientation "v"; + } + if {[expr {%s & $HiresScrollMask}]} { + tk::ScrollByUnits %W $orientation %D -10.0 + } else { + tk::ScrollByUnits %W $orientation [tk::ScaleNum %D] -30.0 + } } bind Scrollbar <Option-MouseWheel> { - tk::ScrollByUnits %W hv %D -12.0 + if {[expr {%s & $ShiftMask}]} { + set orientation "h"; + } else { + set orientation "v"; + } + if {[expr {%s & $HiresScrollMask}]} { + tk::ScrollByUnits %W $orientation %D -1.0 + } else { + tk::ScrollByUnits %W $orientation [tk::ScaleNum %D] -3.0 + } } # tk::ScrollButtonDown -- @@ -308,16 +328,24 @@ proc ::tk::ScrollEndDrag {w x y} { proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} { set cmd [$w cget -command] - if {$cmd eq "" || ([string first \ - [string index [$w cget -orient] 0] $orient] < 0)} { + if {$cmd eq ""} { return } - set info [$w get] - if {[llength $info] == 2} { - uplevel #0 $cmd scroll [expr {$amount/$factor}] units - } else { - uplevel #0 $cmd [expr {[lindex $info 2] + [expr {$amount/$factor}]}] + set xyview [lindex [split $cmd] end] + if {$orient eq "v"} { + if {$xyview eq "xview"} { + return + } + set size [winfo height $w] + } + if {$orient eq "h"} { + if {$xyview eq "yview"} { + return + } + set size [winfo width $w] } + set scale [expr {[$w delta 1.0 1.0] * $size}] + uplevel #0 $cmd scroll [expr {$amount * $scale / $factor}] units } # ::tk::ScrollByPages -- |