#============================================================#
# 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 $TEXTulis, 2003-08-15: Interesting :)
