# ------------------------------------------------------ # A demo application using the canvas widget that lets the # user draw oval objects using the mouse. This demo # is included in the standard release of Tcl/Tk. # # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # ------------------------------------------------------ proc startoval {w x y} { global ovallocation catch {unset ovallocation} set ovallocation(xorig) $x set ovallocation(yorig) $y set tx [expr $x + 1] set ty [expr $y + 1] set ovallocation(obj) \ [$w create oval $x $y $tx $ty -fill red \ -stipple gray25] } proc dragoval {w x y} { global ovallocation $w coords $ovallocation(obj) \ $ovallocation(xorig) \ $ovallocation(yorig) $x $y } proc endoval {w x y} { global ovallocation $w delete $ovallocation(obj) set ovallocation(obj) \ [$w create oval $ovallocation(xorig) \ $ovallocation(yorig) \ $x $y -fill blue] $w addtag tag$ovallocation(obj) withtag \ $ovallocation(obj) $w bind tag$ovallocation(obj) \ [list %W itemconfigure \ $ovallocation(obj) -fill yellow] $w bind tag$ovallocation(obj) \ [list %W itemconfigure \ $ovallocation(obj) -fill blue] } canvas .c -width 400 -height 400 -background bisque \ -relief groove -highlightt 0 bind .c {startoval %W %x %y} bind .c {dragoval %W %x %y} bind .c {endoval %W %x %y} bind .c {%W delete current} pack .c focus .c