xybutton

adavis: Having been playing with Emulating Third Mouse Button Using Two Button Mouse I thought of another use for it. This is something to put in that little spare space, usually at the bottom right of a widget with "X" (horizontal) and "Y" (vertical) scrollbars, where the scrollbars "join".

This is a square "button" which can be used to perform both vertical and horizontal scrolling by using the mouse buttons only.

The xybutton displays, by default, a vertical raised bar. The mouse-pointer, when over the xybutton, changes to a double-ended vertical arrow. This indicates that the xybutton is in vertical scolling mode. When the mouse-button is over the xybutton the left mouse button scrolls up and the right button scolls down.

With the mouse-pointer over the xybutton pressing the middle mouse button -or- both mouse buttons together, toggles the xybutton between vertical and horizontal scrolling modes.

When in horizontal scolling mode (The raised bar is displayed horizontal and the mouse-pointer is a horizontal double-ended arrow) the left mouse button scrolls left and the right mouse button scrolls right.

This program uses a modified version of button13 which allows the button to repeat. It is therefore possible to continuously scroll by holding down the left/right mouse buttons.

 #============================================================#
 # xybutton - Create button to perform "X" and "Y" scrolling. #
 #            Uses modified "button13" with repeat facility.  #
 #============================================================#
 
 #------------------------------------#
 # button13: Set-up "Button-13" event #
 #------------------------------------#
 
 proc button13 {widget {ms 200}} {
    bind $widget <Button-1> "button13proc1 $widget 1 $ms"
    bind $widget <ButtonRelease-1> "button13proc4"
    bind $widget <Button-3> "button13proc1 $widget 3 $ms"
    bind $widget <ButtonRelease-3> "button13proc4"
 }
 
 #----------------------------------------#
 # button13: Deal with mouse button press #
 #----------------------------------------#
 
 proc button13proc1 {widget button ms} {
    global button13
 
    set button13(down) 1
 
    if {[info exists button13($widget)] && ! [string equal $button13($widget) $button]} {
       event generate $widget <<Button-13>>
       catch "unset button13($widget)"
       return
    }
 
    set button13($widget) $button
 
    after $ms "button13proc2 $widget $button"
 }
 
 #-----------------------------------------------------------#
 # button13: Check if both buttons pressed within time limit #
 #-----------------------------------------------------------#
 
 proc button13proc2 {widget button} {
    global button13
 
    if {! [info exists button13($widget)]} {
       return
    }
 
    if {[info exists button13($widget)] && ! [string equal $button13($widget) $button]} {
       event generate $widget <<Button-13>>
    } else {
       if {$button13(down)} {set button13(startID) [after 500 "button13proc3 $widget $button"]}
       event generate $widget <<Button-$button>>
    }
 
    catch "unset button13($widget)"
 }
 
 #------------------------#
 # button13: Repeat event #
 #------------------------#
 
 proc button13proc3 {widget button} {
    global button13
 
    set button13(repeatID) [after 50 "event generate $widget <<Button-$button>>;button13proc3 $widget $button"]
 }
 
 #-------------------------#
 # button13: Cancel repeat #
 #-------------------------#
 
 proc button13proc4 {} {
    global button13
 
    set button13(down) 0
 
    if {[info exists button13(startID)]} {
       after cancel $button13(startID)
    }
    if {[info exists button13(repeatID)]} {
       after cancel $button13(repeatID)
    }
 }
 
 #-----------------------------#
 # xybutton: Create "xybutton" #
 #-----------------------------#
 
 proc xybutton {name target size {orient y}} {
    frame $name            -width $size -height $size -relief raised -borderwidth 1 
    frame $name.frame      -width $size -height $size
    frame $name.frame.line -width 4 -height 4 -relief raised -borderwidth 4
 
    grid propagate $name.frame 0
    grid $name.frame -sticky nsew
 
    grid columnconfigure $name.frame 0 -weight 1
    grid rowconfigure    $name.frame 0 -weight 1
 
    $name.frame      configure -background gray65
    $name.frame.line configure -relief raised
 
    if {[string equal $orient "y"]} {
       $name configure -cursor sb_h_double_arrow
    } else {
       $name configure -cursor sb_v_double_arrow
    }
 
    xybuttonToggle $name
 
    button13 $name
    button13 $name.frame
    button13 $name.frame.line
 
    bind $name            <<Button-1>>  "xybuttonScroll $name $target -1"
    bind $name.frame      <<Button-1>>  "xybuttonScroll $name $target -1"
    bind $name.frame.line <<Button-1>>  "xybuttonScroll $name $target -1"
    bind $name            <<Button-3>>  "xybuttonScroll $name $target  1"
    bind $name.frame      <<Button-3>>  "xybuttonScroll $name $target  1"
    bind $name.frame.line <<Button-3>>  "xybuttonScroll $name $target  1"
    bind $name            <<Button-13>> "xybuttonToggle $name"
    bind $name.frame      <<Button-13>> "xybuttonToggle $name"
    bind $name.frame.line <<Button-13>> "xybuttonToggle $name"
    bind $name             <Button-2>   "xybuttonToggle $name"
    bind $name.frame       <Button-2>   "xybuttonToggle $name"
    bind $name.frame.line  <Button-2>   "xybuttonToggle $name"
 }
 
 #-------------------------------------------------#
 # xybutton: Toggle between "X" and "Y" directions #
 #-------------------------------------------------#
 
 proc xybuttonToggle {name} {
    if {[string equal [$name cget -cursor] "sb_h_double_arrow"]} {
       grid $name.frame.line -sticky ns
       $name            configure -cursor sb_v_double_arrow
       $name.frame      configure -cursor sb_v_double_arrow
       $name.frame.line configure -cursor sb_v_double_arrow
    } else {
       grid $name.frame.line -sticky ew
       $name            configure -cursor sb_h_double_arrow
       $name.frame      configure -cursor sb_h_double_arrow
       $name.frame.line configure -cursor sb_h_double_arrow
    }
 }
 
 #--------------------------#
 # xybutton: Scroll command #
 #--------------------------#
 
 proc xybuttonScroll {name target direction} {
    if {[string equal [$name cget -cursor] "sb_v_double_arrow"]} {
       set orient yview
    } else {
       set orient xview
    }
 
    set scrollCommand "$target $orient scroll $direction unit"
 
    eval $scrollCommand
 }
 
 #==================#
 # Example of usage #
 #==================#
 
 frame     .frame      -relief groove -borderwidth 2
 text      .frame.text -width 20 -height 5 -wrap none -xscrollcommand ".frame.xbar set" -yscrollcommand ".frame.ybar set"
 scrollbar .frame.xbar -orient horizontal -command ".frame.text xview"
 scrollbar .frame.ybar -orient vertical   -command ".frame.text yview"
 xybutton  .frame.xyb .frame.text [.frame.xbar cget -width]
 
 
 grid .frame.text .frame.ybar -sticky nsew
 grid .frame.xbar .frame.xyb  -sticky nsew
 
 grid columnconfigure .frame 0 -weight 1
 grid rowconfigure    .frame 0 -weight 1
 
 pack .frame
 
 set TEXT "Now is the time for all good men
 to come to the aid of the party.
 
 The quick brown fox jumps over the
 lazy dog. Now is the time, yet again for all good men
 to come to the aid of the party.
 
 And this is, of course, more space filling rubbish.
 
 I could go on. I could go on and on. I could go on and on and...
 
 ...But that would be very boring indeed. I guess it is about time
 to wrap this up.
 
 THE END"
 
 .frame.text insert end $TEXT

ulis, 2003-08-15: Interesting :)