WJG (21 January 2005) Sometimes the most simplest of tasks can be frustrating. For me, restricting the movement of canvas items was one of these niggly little things. Much of the code we see here on the Wiki gives advice and on how to get things moving but little nothing about stopping the little buggers becoming dragged out of the canvas view.
package require Tk
#-------
# movement handler
#-------
proc drag.canvas.item {canWin item newX newY} {
set xDiff [expr {$newX - $::x}]
set yDiff [expr {$newY - $::y}]
#test before moving
if {[inside $canWin $item $xDiff $yDiff]} {
puts inside
$canWin move $item $xDiff $yDiff
}
set ::x $newX
set ::y $newY
}
#-------
# test to see if the new position is outside the canvas viewport
#-------
proc inside {w item xDiff yDiff} {
#canvas extents
set can(minx) -1
set can(miny) -1
set can(maxx) [winfo width $w ]
set can(maxy) [winfo height $w ]
#item coords
set item [$w coords $item]
#check min values
foreach {x y} $item {
set x [expr $x + $xDiff]
set y [expr $y + $yDiff]
if {$x < $can(minx)} {
return 0
}
if {$y < $can(miny)} {
return 0
}
if {$x > $can(maxx)} {
return 0
}
if {$y > $can(maxy)} {
return 0
}
}
#puts $item
return 1
}
#-------
# test it
#-------
pack [canvas .c -bg white] -expand 1 -fill both
button .b -text "Test Button"
.c create rectangle 0 0 100 100 -fill red -tag tag
.c bind tag <1> {
set ::x %X
set ::y %Y
}
.c bind tag <B1-Motion> [list drag.canvas.item .c tag %X %Y]