Tcl Plugin Demo: Dragable Text

[Sun Home | Tcl Plugin | Demos]

Here is some text you can drag around by grabbing it with the left mouse button and moving the mouse:


Here's the source for the Dragable Text demo:

proc dragstart {w x y} { global draglocation catch {unset draglocation} set draglocation(obj) [$w find closest $x $y] set draglocation(x) $x set draglocation(y) $y } proc dragit {w x y} { global draglocation if {"$draglocation(obj)" != ""} { set dx [expr $x - $draglocation(x)] set dy [expr $y - $draglocation(y)] $w move $draglocation(obj) $dx $dy set draglocation(x) $x set draglocation(y) $y } } canvas .c -bg bisque -width 400 -height 400 .c create text 50 50 -text Hello -font *-times-bold-r-*-18-* \ -tags {movable color=red} -fill red .c create text 100 100 -text World -font *-times-medium-i-*-18-* \ -tags {movable color=blue} -fill blue .c bind movable <Button-1> {dragstart %W %x %y} .c bind movable <B1-Motion> {dragit %W %x %y} pack .c