[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 {resize'rect %W %x %y} ---- [Category Example] - [Category Graphics] - [Arts and crafts of Tcl-Tk programming]