# canvas_grab_scrolling.tcl --
#
# Part of: Useless Widgets Package
# Contents: test script for the grab scrolling
# Date: Sun Jan 16, 2005
#
# Abstract
#
# Scrolls a canvas by dragging the mouse. This version makes use
# of the "scan" widget subcommand, instead of the "scroll" one.
#
# Copyright (c) 2005 Marco Maggi
#
# The author hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose,
# provided that existing copyright notices are retained in all copies
# and that this notice is included verbatim in any distributions. No
# written agreement, license, or royalty fee is required for any of the
# authorized uses. Modifications to this software may be copyrighted by
# their authors and need not follow the licensing terms described here,
# provided that the new terms are clearly indicated on the first page of
# each file where they apply.
#
# IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
# NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS,
# AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
#
#page
## ------------------------------------------------------------
## Setup.
## ------------------------------------------------------------
package require Tcl 8.4
package require Tk 8.4
#page
## ------------------------------------------------------------
## Widget options.
## ------------------------------------------------------------
option add *borderWidth 1
option add *Canvas.uwp_grab_scroller_grab_cursor fleur
option add *Canvas.uwp_grab_scroller_ungrab_cursor hand2
# Possible values: quick_scroll, sticky_mouse, an integer
# selecting the "gain" directly (see the canvas man page,
# "scan dragto" subcommand).
option add *a.uwp_grab_scroller_gain quick_scroll
option add *b.uwp_grab_scroller_gain sticky_mouse
#page
## ------------------------------------------------------------
## Main.
## ------------------------------------------------------------
proc main {} {
global exit_trigger
wm title . "Canvas Grab Scrolling"
wm geometry . +200+100
grid [frame .f] -sticky news
canvas [set a .f.a] -width 300 -height 300 -background white
canvas [set b .f.b] -width 300 -height 300 -background white
grid $a $b -sticky news -padx 5
put_rectangles $a
put_rectangles $b
uwp_grab_scroller_bind $a
uwp_grab_scroller_bind $b
grid [button .quit -text Exit -command main_exit]
focus .quit
bind .quit <Return> main_exit
bind . <Escape> main_exit
interp alias {} main_exit {} set exit_trigger 1
vwait exit_trigger
exit
}
proc put_rectangles { c } {
set max [expr {2*[$c cget -width]}]
for {set i 0} {$i < 15} {incr i} {
$c create rectangle \
[set x [expr {10*$i*2}]] $x [set y [expr {$max-$x}]] $y
}
$c create line 0 0 $max $max
$c create line 0 $max $max 0
$c configure -scrollregion [list 0 0 $max $max]
}
#page
proc uwp_data_set { widget key value } {
global uwp_data
set uwp_data($widget:$key) $value
}
proc uwp_data_get { widget key } {
global uwp_data
return $uwp_data($widget:$key)
}
proc uwp_p_append_tag { tag widget } {
bindtags $widget [linsert [bindtags $widget] end $tag]
}
proc uwp_p_remove_tag { tag widget } {
set idx [lsearch [set ell [bindtags $widget]] $tag]
bindtags $widget [lreplace $ell $idx $idx]
}
proc alias { alias args } {
eval { interp alias {} $alias {} } $args
}
#page
bind GrabScroller <ButtonPress-1> { uwp_grab_scroller_event_press %W %x %y }
bind GrabScroller <ButtonRelease-1> { uwp_grab_scroller_event_release %W }
bind GrabScroller <Enter> { uwp_grab_scroller_event_enter %W }
bind GrabScroller <Leave> { uwp_grab_scroller_event_leave %W }
bind GrabScrollerScroll <Motion> { uwp_grab_scroller_event_motion %W %x %y }
alias uwp_grab_scroller_bind uwp_p_append_tag GrabScroller
alias uwp_grab_scroller_unbind uwp_p_remove_tag GrabScroller
alias uwp_p_grab_scroller_bind_motion uwp_p_append_tag GrabScrollerScroll
alias uwp_p_grab_scroller_unbind_motion uwp_p_remove_tag GrabScrollerScroll
#page
proc uwp_grab_scroller_event_press { widget x y } {
uwp_p_grab_scroller_bind_motion $widget
uwp_p_grab_scroller_set_grab_cursor $widget
$widget scan mark $x $y
}
proc uwp_grab_scroller_event_release { widget } {
uwp_p_grab_scroller_unbind_motion $widget
uwp_p_grab_scroller_set_ungrab_cursor $widget
}
proc uwp_grab_scroller_event_enter { widget } {
uwp_p_grab_scroller_save_current_cursor $widget
uwp_p_grab_scroller_set_ungrab_cursor $widget
}
proc uwp_grab_scroller_event_leave { widget } {
uwp_p_grab_scroller_restore_current_cursor $widget
}
proc uwp_grab_scroller_event_motion { widget x y } {
switch -exact -- [set gain [option get $widget uwp_grab_scroller_gain {}]] {
sticky_mouse { set gain 1 }
quick_scroll { set gain [expr {[winfo width $widget]/8}] }
default { if { [string length $gain] == 0 } { set gain 10 } }
}
$widget scan dragto $x $y $gain
}
proc uwp_p_grab_scroller_save_current_cursor { widget } {
uwp_data_set $widget oldCursor [. cget -cursor]
}
proc uwp_p_grab_scroller_restore_current_cursor { widget } {
. configure -cursor [uwp_data_get $widget oldCursor]
}
proc uwp_p_grab_scroller_set_grab_cursor { widget } {
. configure -cursor [option get $widget uwp_grab_scroller_grab_cursor {}]
}
proc uwp_p_grab_scroller_set_ungrab_cursor { widget } {
. configure -cursor [option get $widget uwp_grab_scroller_ungrab_cursor {}]
}
#page
## ------------------------------------------------------------
## Let's go.
## ------------------------------------------------------------
main
### end of file
# Local Variables:
# mode: tcl
# End:KPV: There's an easier way of doing almost the exact interaction--just use the bindings that the text widget uses to scrolling via mouse button 2.
canvas .c bind .c <2> [bind Text <2>] bind .c <B2-Motion> [bind Text <B2-Motion>]
anoved: Another simple way to scroll canvas .c with the mouse is:
bind .c <ButtonPress-1> {%W scan mark %x %y}
bind .c <B1-Motion> {%W scan dragto %x %y 1}JG: Thanks ... that's exactly what I was looking for ...