ASPN : Tcl Cookbook : Supporting mouse wheel on vertical scrollbars

Title: Supporting mouse wheel on vertical scrollbars
Submitter: Tsahi Levent-Levi (other recipes)
Last Updated: 2001/09/10
Version no: 1.0
Category: User Interfaces

5 stars 1 vote(s)

Description:

A simple way of adding the mouse's wheel support to a TCL application

Source: Text Source

proc wheelEvent { x y delta } {

    # Find out what's the widget we're on
    set act 0
    set widget [winfo containing $x $y]

    if {$widget != ""} {
        # Make sure we've got a vertical scrollbar for this widget
        if {[catch "$widget cget -yscrollcommand" cmd]} return

        if {$cmd != ""} {
            # Find out the scrollbar widget we're using
            set scroller [lindex $cmd 0]

            # Make sure we act
            set act 1
        }
    }

    if {$act == 1} {
        # Now we know we have to process the wheel mouse event
        set xy [$widget yview]
        set factor [expr [lindex $xy 1]-[lindex $xy 0]]

        # Make sure we activate the scrollbar's command
        set cmd "[$scroller cget -command] scroll [expr -int($delta/(120*$factor))] units"
        eval $cmd
    }
}

bind all <MouseWheel> "+wheelEvent %X %Y %D"

The license for this recipe is available here.

Discussion:

This addition allows Windows users to use the wheel of the mouse as they do today in most Windows applications.
The procedure written in this example, along with the bind should be insterted with minimum changes to existing code.

Add comment

Number of comments: 2

Extension so <Shift-MouseWheel> scrolls horizontally, Keith Vetter, 2001/09/23

proc wheelEvent {x y delta {XorY y}} {

    # Get scroll command for this widget
    set widget [winfo containing $x $y]
    if {$widget == ""} return
    if {[catch {set cmd [$widget cget -${XorY}scrollcommand]}]} return
    if {$cmd == ""} return
    set scmd [[lindex $cmd 0] cget -command]

    # NB. Text and Listbox hardcode factor=4
    set xy [$widget ${XorY}view]
    set factor [expr {[lindex $xy 1] - [lindex $xy 0]}]

    # Make sure we activate the scrollbar's command
    set cmd "$scmd scroll [expr -int($delta/(120*$factor))] units"
    eval $cmd
}

bind all  "+wheelEvent %X %Y %D y"
bind all  "+wheelEvent %X %Y %D x"

Add comment

Extension to Unix, Danger note, andreas kupries, 2001/09/28

# Support for mousewheels on Linux/Unix commonly comes through
# mapping the wheel to the extended buttons. If you have a
# mousewheel, find Linux configuration info at: 
#
# http://www.inria.fr/koala/colas/mouse-wheel-scroll/ 

if {[string equal "unix" $tcl_platform(platform)]} { 
    bind all # Support for mousewheels on Linux/Unix commonly comes through
# mapping the wheel to the extended buttons. If you have a
# mousewheel, find Linux configuration info at: 
#
# http://www.inria.fr/koala/colas/mouse-wheel-scroll/ 

if {[string equal "unix" $tcl_platform(platform)]} { 
    bind all

Add comment

Highest rated recipes:

1. A minimal debugger

2. Socket based communicatio...

3. With busy cursor

4. Multi-character split

5. LCD Number Display

6. Supporting mouse wheel ...

7. Get widget info

8. Check creditcard numbers ...

9. WSCP - showServerStatus

10. Inline GIF image into ...