Source code:
# ------------------------------------------------------------ # A demo application using the canvas widget that lets the user # draw line objects with 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 StrokeBegin {w x y} { global stroke catch {unset stroke} set stroke(N) 0 set stroke(0) [list $x $y] } proc Stroke {w x y} { global stroke set last $stroke($stroke(N)) incr stroke(N) set stroke($stroke(N)) [list $x $y] eval {$w create line} $last\ {$x $y -tag segments -fill blue} } proc StrokeEnd {w x y} { global stroke set points {} for {set i 0} {$i <= $stroke(N)} {incr i} { append points $stroke($i) " " } $w delete segments eval {$w create line} $points \ {-smooth true -tag line -fill red -width 5} } canvas .c -width 400 -height 400 -highlightt 0 \ -background bisque bind .c {StrokeBegin %W %x %y} bind .c {Stroke %W %x %y} bind .c {StrokeEnd %W %x %y} bind .c {%W delete [%W find closest %x %y]} .c bind line {%W itemconfigure \ [%W find closest %x %y] \ -fill blue} .c bind line {%W itemconfigure \ [%W find closest %x %y] \ -fill red} pack .c focus .c