Tk Source Code

Artifact 68c7aca95a9169f705a5c0de7b1fecce9f39c5a3fe9eb25ec21ac6c91843a009:

Attachment "BWidgetDnd.tcl" to ticket [855ec435] added by nemethi 2025-04-06 11:27:45.

---

package require BWidget

label .l -text "Drag Source" -background white -borderwidth 1 -relief solid \
	 -padx 5 -pady 5
listbox .lb -width 0 -font TkFixedFont
pack .l -padx 10 -pady 10
pack .lb -padx 10 -pady {0 10} -expand yes -fill both

DragSite::register .l -dragevent 1 -draginitcmd dragInitCmd
DropSite::register .lb -dropovercmd dropOverCmd -dropcmd dropCmd \
    -droptypes [list DATE_TIME {copy {}}]

proc dragInitCmd {dragSrc rootX rootY top} {
    return [list DATE_TIME {copy} " [clock format now] "]
}

proc dropOverCmd {dropTarget dragSrc event rootX rootY op dataType data} {
    DropSite::setcursor based_arrow_down
    return 1						;# accept the drop
}

proc dropCmd {dropTarget dragSrc rootX rootY op dataType data} {
    $dropTarget insert end $data
    return 1						;# accept the drop
}