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:

Source:

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