Updated 2005-03-10 15:32:59 by lwv

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]

Category GUI Category Widget