[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.

 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:
 package require Tk
 pack [canvas .c]
 .c create rect 50 50 100 100 -fill red -tag rsz
 .c create rect 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}

----
[Category Example] - [Arts and crafts of Tcl-Tk programming]