#############################################################################
# Visual Tcl v1.20 Project
#
#################################
# USER DEFINED PROCEDURES
#
proc {main} {argc argv} {
}
#
# A good GUI needs only one mouse button
#
event add <<Loslassen>> <ButtonRelease-1>
event add <<Loslassen>> <ButtonRelease-2>
event add <<Loslassen>> <ButtonRelease-3>
event add <<Ziehen>> <B1-Motion>
event add <<Ziehen>> <B2-Motion>
event add <<Ziehen>> <B3-Motion>
event add <<Klick>> <1>
event add <<Klick>> <2>
event add <<Klick>> <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 <<Klick>> "plotDown $Canv %x %y"
$Canv bind ent$i <<Ziehen>> "plotMove $Canv %x %y"
$Canv bind ent$i <<Loslassen>> "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 $argvA 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.MG May 12th 2005 - Very nice. One "bug" that I noticed is that, when scrolling items appearing at the end of the list do so when only half is visible inside the listbox, which means the other half of the item "hangs out", over the listbox border/rest of the canvas. I can't think of a particularly good way to fix it, though - only things which spring to mind are not having the items appear, until they'd be wholly inside the listbox, or drawing a rectangle above/below the listbox which would obscure the non-visible half of the entry (which is a very nasty hack, I think).
