[Peter K]: To improve usability of a GUI, I implemented a virtual listbox in a canvas, so all listbox items can be dragged around. The first example shows how this can be employed for re-ordering the items: ############################################################################# # Visual Tcl v1.20 Project # ################################# # USER DEFINED PROCEDURES # proc {main} {argc argv} { } # # A good GUI needs only one mouse button # event add <> event add <> event add <> event add <> event add <> event add <> event add <> <1> event add <> <2> event add <> <3> # # Stuff from Visual Tcl. Not pretty, and I don't know if I really need # all this, but it works. # proc {Window} {args} { # set cmd [lindex $args 0] set name [lindex $args 1] set newname [lindex $args 2] set rest [lrange $args 3 end] if {$name == "" || $cmd == ""} {return} if {$newname == ""} { set newname $name } set exists [winfo exists $newname] switch $cmd { show { if {$exists == "1" && $name != "."} {wm deiconify $name; return} if {[info procs vTclWindow(pre)$name] != ""} { eval "vTclWindow(pre)$name $newname $rest" } if {[info procs vTclWindow$name] != ""} { eval "vTclWindow$name $newname $rest" } if {[info procs vTclWindow(post)$name] != ""} { eval "vTclWindow(post)$name $newname $rest" } } hide { if $exists {wm withdraw $newname; return} } iconify { if $exists {wm iconify $newname; return} } destroy { if $exists {destroy $newname; return} } } } ################################# # VTCL GENERATED GUI PROCEDURES # proc vTclWindow. {base} { if {$base == ""} { set base . } ################### # CREATING WIDGETS ################### wm focusmodel $base passive wm geometry $base 1x1+25+65 wm maxsize $base 817 594 wm minsize $base 1 1 wm overrideredirect $base 0 wm resizable $base 1 1 wm withdraw $base wm title $base "Wish" } # # Open a widow for the test dialog. Left half = Scrollbox. # Right: Some entries and a message for testing the code. # proc vTclWindow.dialog {base} { global Pref global PosX global PosY global Delta # if {$base == ""} { set base .dialog } if {[winfo exists $base]} { wm deiconify $base; return } ################### # CREATING WIDGETS ################### toplevel $base -class Toplevel -relief groove wm focusmodel $base passive wm geometry $base 360x280+100+120 wm maxsize $base 817 594 wm minsize $base 1 1 wm overrideredirect $base 0 wm resizable $base 1 1 wm deiconify $base wm title $base "Sort-by-Drag Listbox" set Delta 30 # font create Pref(Font) -family System -size 12 font create Pref(Fett) -family Helvetica -size 12 -weight bold set Pref(Fill) yellow # # fill a list with entries # set Eintraege [list ] for {set i 1} {$i < 21} {incr i} { lappend Eintraege "Item $i" } # # One call creates the listbox # set Canv [Sort-by-Drag_Listbox .dialog $Eintraege 20 20 150 240] # # Widgets on the right side # label $base.xl -text X -font Pref(Font) -anchor e label $base.yl -text Y -font Pref(Font) -anchor e entry $base.x -textvariable PosX -width 12 -font Pref(Font) \ -justify center entry $base.y -textvariable PosY -width 12 -font Pref(Font) \ -justify center button $base.ok -text Quit -command exit -width 12 -default active label $base.dl -text Delta -font Pref(Font) -anchor e entry $base.d -textvariable Delta -width 12 -font Pref(Font) \ -justify center message $base.m -width 140 \ -text "Sort the list by dragging the entries with the mouse.\ \nDelta fine-tunes the drop position." # # Position all widgets # place $base.xl -x 236 -y 30 -anchor e place $base.yl -x 236 -y 60 -anchor e place $base.x -x 240 -y 30 -anchor w place $base.y -x 240 -y 60 -anchor w place $base.dl -x 236 -y 110 -anchor e place $base.d -x 240 -y 110 -anchor w place $base.m -x 200 -y 135 -anchor nw place $base.ok -x 220 -y 250 -anchor w } # # Create a pseudo-listbox with canvas elements. Looks like a listbox, # but is really a canvas, and all widgets only pretend to be what they seem. # proc Sort-by-Drag_Listbox { base Eintraege XNull YNull Breite Hoehe } { global Pref global Index global Eintrag global Scrollposition global Scrollbereich # set Canv [canvas $base.cv -borderwidth 0 -highlightthickness 0 \ -height [expr $Hoehe + 2*$YNull] -width [expr $Breite + 2*$XNull] \ -bg $Pref(Fill)] # # Create the box with a scrollbar on the right # $Canv create rectangle $XNull $YNull [expr $XNull + $Breite] \ [expr $YNull + $Hoehe] -outline black -width 1 -fill white -tags Box $Canv create rectangle [expr $XNull - 1] [expr $YNull - 1] \ [expr $XNull + $Breite + 1] [expr $YNull + $Hoehe + 1] \ -outline grey50 -width 1 -tags Box scrollbar $base.lbscroll -command "Sort-by-Drag_ListboxScroll $base" \ -borderwidth 0 -orient vert -width 16 -cursor left_ptr place $Canv -x 0 -y 0 -anchor nw place $base.lbscroll -x [expr $XNull + $Breite - 16] -y $YNull \ -anchor nw -width 16 -height $Hoehe # # Fill the box with the list # for {set i 0} {$i < [llength $Eintraege]} {incr i} { set Eintrag($i) "[lindex $Eintraege $i]" lappend Index($i) $i } set Scrollposition 0 set Schrifthoehe [expr int(1.5 * [font configure Pref(Fett) -size])] set Scrollbereich [expr $Schrifthoehe * [llength $Eintraege]] Sort-by-Drag_ListboxScroll $base scroll 0.0 units # return $Canv } # # Scrollbar code. # proc Sort-by-Drag_ListboxScroll { base {was moveto} {Zahl 0.0} {Einheit units} } { global Pref global Index global Eintrag global Scrollposition global Scrollbereich # set Canv $base.cv set Hoehe [lindex [$Canv configure -height] 4] set Schrifthoehe [expr int(1.5 * [font configure Pref(Fett) -size])] # if {$was == "scroll"} { if {$Einheit == "pages"} { incr Scrollposition [expr int($Zahl * $Hoehe - 20)] } else { incr Scrollposition [expr 20 * int($Zahl)] } } else { set Scrollposition [expr int($Zahl * $Scrollbereich)] } # # Limit the scrollposition to sensible values # if {$Scrollposition > [expr $Scrollbereich - $Hoehe]} { set Scrollposition [expr $Scrollbereich - $Hoehe] } if {$Scrollposition < 0} {set Scrollposition 0} # # Delete Index and built anew from scratch. In priciple all entries could # be moved, but this is messy at the edges. # set yPos [expr 32 - $Scrollposition] for {set i 0} {$i < [array size Eintrag]} {incr i} { $Canv delete ent$i if {$yPos < 20} { incr yPos $Schrifthoehe continue } # if {$yPos < [expr $Hoehe - 20]} { $Canv create text 24 $yPos -text $Eintrag($Index($i)) \ -anchor w -font Pref(Fett) -fill black -tags ent$i incr yPos $Schrifthoehe # # Bindings for dragging and dropping of items. # $Canv bind ent$i <> "plotDown $Canv %x %y" $Canv bind ent$i <> "plotMove $Canv %x %y" $Canv bind ent$i <> "plotCopy $base $Canv %x %y $i" } } # $base.lbscroll set [expr double($Scrollposition) / $Scrollbereich] \ [expr double($Hoehe + $Scrollposition) / $Scrollbereich] } # # plotDown -- # This procedure is invoked when the mouse is pressed over one of the # data points. It sets up state to allow the point to be dragged. # # Arguments: # w - The canvas window. # x, y - The coordinates of the mouse press. # proc plotDown {w x y} { global plot # $w dtag selected $w addtag selected withtag current $w raise current set plot(lastX) $x set plot(lastY) $y } # plotMove -- # This procedure is invoked during mouse motion events. It drags the # current item. # # Arguments: # w - The canvas window. # x, y - The coordinates of the mouse. # proc plotMove { w x y } { global plot global PosX global PosY # $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)] set plot(lastX) $x set plot(lastY) $y set PosX $x set PosY $y } # # When the mouse button is released, this routine determines the new # position and re-orders the list. # proc plotCopy { base Cv x y i } { global Pref global Delta global Index global Scrollposition global Scrollbereich # set Hoehe [lindex [$Cv configure -height] 4] set Schrifthoehe [expr int(1.5 * [font configure Pref(Fett) -size])] # # Get the new position. Delta is a fudge factor which is different # between different operating systems. # set Rang [expr int(($y - $Delta + $Scrollposition) / $Schrifthoehe)] puts stdout "Drop at $Rang = $y - $Delta + $Scrollposition / $Schrifthoehe" set Speicher $Index($i) if {$Rang > $i} { for {set j $i} {$j < $Rang} {incr j} { set Index($j) $Index([expr $j + 1]) puts stdout "Index($j) becomes $Index($j)" } } elseif {$Rang == $i} { set Zahl [expr double($Scrollposition) / $Scrollbereich] Sort-by-Drag_ListboxScroll $base scroll $Zahl units return } else { set Rang [expr $Rang + 1] for {set j $i} {$j > $Rang} {incr j -1} { set Index($j) $Index([expr $j - 1]) puts stdout "Index($j) becomes $Index($j)" } } set Index($Rang) $Speicher # # Now scroll the list to the right position. # set Zahl [expr double($Scrollposition) / $Scrollbereich] Sort-by-Drag_ListboxScroll $base scroll $Zahl units } # Window show . Window show .dialog #console hide main $argc $argv A second use is to define the values in an X-Y-plot. One list presents all possible parameters, and by dragging them the X and Y values of a Cartesian plot can be defined in the most intuitive way. Mail me for the code. ---- [Category GUI]