[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 and 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-pinter is a horizontal double-ended arrow) the left mouse button scrolls left and the right mouse button scrolls right. This program uses a modified verion of '''button13''' which allows the button to repeat. It is therefore possible to continuosuly 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 "button13proc1 $widget 1 $ms" bind $widget "button13proc4" bind $widget "button13proc1 $widget 3 $ms" bind $widget "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 <> 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 <> } else { if {$button13(down)} {set button13(startID) [after 500 "button13proc3 $widget $button"]} event generate $widget <> } catch "unset button13($widget)" } #------------------------# # button13: Repeat event # #------------------------# proc button13proc3 {widget button} { global button13 set button13(repeatID) [after 100 "event generate $widget <>;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 <> "xybuttonScroll $name $target -1" bind $name.frame <> "xybuttonScroll $name $target -1" bind $name.frame.line <> "xybuttonScroll $name $target -1" bind $name <> "xybuttonScroll $name $target 1" bind $name.frame <> "xybuttonScroll $name $target 1" bind $name.frame.line <> "xybuttonScroll $name $target 1" bind $name <> "xybuttonToggle $name" bind $name.frame <> "xybuttonToggle $name" bind $name.frame.line <> "xybuttonToggle $name" bind $name "xybuttonToggle $name" bind $name.frame "xybuttonToggle $name" bind $name.frame.line "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