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 BWidgets drag and drop), or binary extensionsnot 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!
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 * }
enter categories here |
---|