Some Drag(able) Text

Hosted by

HOME
ABOUT TCL/TK
SOFTWARE
CORE DEVELOPMENT
COMMUNITY
DOCUMENTATION

Tcl Plugin Demo: Dragable Text

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
.c create text 50 50 -text Hello -font {Times 18 bold} -tag movable -fill red
.c create text 100 100 -text World -font {Times 18} -tag movable -fill blue
.c bind movable <Button-1> {dragstart %W %x %y}
.c bind movable <B1-Motion> {dragit %W %x %y}
pack .c -fill both -expand 1