Richard Suchenwirth 2006-04-19 - A question on comp.lang.tcl prompted me to experiment how one could interactively resize a rectangle on a canvas. Just click close enough to the center of a side, then you can "move" that side with mouse button 1 held down. Should you click elsewhere, you can move the whole rectangle around.
KPV The code at Print Area Selector does something very similar except more so. I wrote it so you can select a portion of a canvas to print; you can move the box, resize it horizontally or vertically by selecting along any side or resize it in both dimensions if you select any corner. It also changes the cursor as you move around the different hot spots.
proc resize'rect'click {w x y} {
global X Y RSZPOS ID
set X [$w canvasx $x]
set Y [$w canvasy $y]
catch {unset RSZPOS}
set ID [$w find withtag current]
set coords [$w coords $ID]
foreach {x0 y0 x1 y1} $coords break
if {[between $x0 $y0 $X $Y $x0 $y1]} {
set RSZPOS 0
} elseif {[between $x0 $y1 $X $Y $x1 $y1]} {
set RSZPOS 3
} elseif {[between $x1 $y1 $X $Y $x1 $y0]} {
set RSZPOS 2
} elseif {[between $x1 $y0 $X $Y $x0 $y0]} {
set RSZPOS 1
}
}
proc resize'rect {w x y} {
global X Y RSZPOS ID
set x [$w canvasx $x]
set y [$w canvasy $y]
if [info exists RSZPOS] {
set coords [$w coords $ID]
set d [expr {$RSZPOS%2? $y: $x}]
$w coords $ID [lset coords $RSZPOS $d]
} else {
$w move $ID [expr {$x-$X}] [expr {$y-$Y}]
}
set X $x; set Y $y
}
proc between {x0 y0 x1 y1 x2 y2} {
set t 10
set xm [expr {($x0+$x2)/2.}]
set ym [expr {($y0+$y2)/2.}]
expr {abs($xm-$x1)<$t && abs($ym-$y1)<$t}
}
#-- Testing, demo, usage example (showing that this works for ovals, too):
package require Tk
pack [canvas .c]
.c create rect 50 50 100 100 -fill red -tag rsz
.c create oval 150 50 200 100 -fill blue -tag rsz
.c bind rsz <1> {resize'rect'click %W %x %y}
.c bind rsz <B1-Motion> {resize'rect %W %x %y}