Kevin Walzer: For some time I've been looking for a simple mechanism to provide drag-and-drop within a Tk application. The idea is to register widgets to be drag sources and/or drop targets, to provide a means for visual display of the drag, and a mechanism to execute a callback when a valid drop is made. While there are lots of code snippets and packages available at the wiki and elsewhere, they are either too complicated (such as BWidget drag and drop), or binary extensions not supported on all platforms (such as TkDND).
The result is that I have developed my own package, called SimpleDND. The basic code, including a demo, is below. If others find this useful, I may submit it to tklib in the future. Feedback and improvements are also welcome!
The code below is indebted to Bryan Oakley's dnd example at [L1 ], and to Ken Jones' example at [L2 ].
namespace eval simplednd {
#create the drag icon with text and image; then hide the icon
proc makeDragIcon {txt img} {
toplevel .dnd
wm overrideredirect .dnd true
label .dnd.view -image $img -text $txt -compound left
pack .dnd.view
wm withdraw .dnd
}
#register widget to respond to drag events: widget to register, its target widget, callback to associate with this drag event, text for the drag label, and image for the drag label
proc dragRegister {w target cmd txt img } {
catch {simplednd::makeDragIcon $txt $img}
puts "$w registered as dragsite with $target as the drop target"
#binding for when drag motion begins
bind $w <B1-Motion> [list [namespace current]::dragMove %W %X %Y $txt $img]
#binding for when drop event occurs
bind $w <ButtonRelease-1> [list [namespace current]::dragStop %W %X %Y $target $cmd ]
}
#drag motion with following args: source widget, cursor x position, cursor y position, label text, label image
proc dragMove {w x y txt img} {
wm deiconify .dnd
#configure drag icon with customized text and image
.dnd.view configure -text [[namespace current]::getText $w] -image [[namespace current]::getImg $w]
catch {raise .dnd}
set x [expr {$x - ([winfo reqwidth .dnd] / 2)}]
set y [expr {$y - [winfo reqheight .dnd] + 4}]
wm geometry .dnd +$x+$y
update
}
#dragstop/drop event with following args: source widget, cursor x position, cursor y position, target widget, callback: if over drop target, execuate callback; otherwise simply return
proc dragStop {w x y target cmd} {
wm withdraw .dnd
if {[winfo containing $x $y] != $target} {
puts "target $w not reached"
} else {
focus -force $target
eval $cmd
}
}
#demo package
proc demo {} {
#create image for demo
image create photo dnd_demo -data {R0lGODlhEAAQALMAAAAAAMbGxv//////////////////////////////////\
/////////////////////yH5BAEAAAEALAAAAAAQABAAAAQwMMhJ6wQ4YyuB\
+OBmeeDnAWNpZhWpmu0bxrKAUu57X7VNy7tOLxjIqYiapIjDbDYjADs=}
listbox .l -selectmode single -activestyle none
listbox .b -selectmode single -activestyle none
foreach item {do re mi} {
.l insert end $item
}
foreach item {fa so la} {
.b insert end $item
}
pack .l -side left
pack .b -side right
#register drag sources with empty text and image to initialize
dragRegister .l .b [namespace current]::move_l {} {}
dragRegister .b .l [namespace current]::move_b {} {}
}
#callback for demo
proc move_l {} {
set item [lindex [.l get [.l curselection]]]
.b insert end $item
.l delete [.l curselection]
}
#second callback for demo
proc move_b {} {
set item [lindex [.b get [.b curselection]]]
.l insert end $item
.b delete [.b curselection]
}
#utility proc to get text for icon label; may need replacing in code
proc getText {w} {
set item [lindex [$w get [$w curselection]]]
return $item
}
#utility proc to get image for icon label; may need replacing in code
proc getImg {w} {
return dnd_demo
}
namespace export *
}