George Peter Staplin: This is a fun weekend project that I wrote. It's a table with resizable columns that works quite nicely. See the end for a screenshot and test/example code.
#By George Peter Staplin #This is public-domain software. You may use it however you #want; with or without giving me credit. #When I get some spare time I will add error handling to the #config instance command, and the initial flags. namespace eval ctable { variable firstX } proc ctable::drawSlider:setInitialPosition x { variable firstX set firstX $x } proc ctable::dragSlider {sep frame1 x} { variable firstX set win [winfo parent $sep] set diff [expr {$x - $firstX}] set xUnits [expr {1.0 / [winfo width $win]}] set haveSecondFrame 0 set frame2 [expr {$frame1 + 1}] array set arF0 [place info $win.f$frame1] array set arS0 [place info $win.sep$frame1] if {[winfo exists $win.f$frame2] == 1} { array set arF1 [place info $win.f$frame2] set haveSecondFrame 1 } set xdiff [expr {$diff * $xUnits}] place $win.f$frame1 -relwidth [expr {$arF0(-relwidth) + $xdiff}] place $win.sep$frame1 -relx [expr {$arS0(-relx) + $xdiff}] if {$haveSecondFrame == 1} { place $win.f$frame2 -relx [expr {$arF1(-relx) + $xdiff}] place $win.f$frame2 -relwidth [expr {$arF1(-relwidth) - $xdiff}] } set firstX $x return } proc ctable {win args} { frame $win set cmdArgs(-columns) 5 set cmdArgs(-rows) 5 array set cmdArgs $args set relxPortion [expr {1.0 / $cmdArgs(-columns)}] set relx 0 for {set i 0} {$i < $cmdArgs(-columns)} {incr i} { place [frame $win.f$i] -relx $relx -relwidth $relxPortion pack [entry $win.f$i.e0 -bg gray70 -relief raised] \ -side top -fill x -padx 6 -ipadx 4 for {set rowIndex 1} {$rowIndex <= $cmdArgs(-rows)} {incr rowIndex} { pack [entry $win.f$i.e$rowIndex] -side top -fill x -padx 6 } set relx [expr {$relx + $relxPortion}] #puts $relx } set relx $relxPortion for {set sepIndex 0} {$sepIndex < ($cmdArgs(-columns) - 1)} {incr sepIndex} { place [frame $win.sep$sepIndex -bg gray70 -width 8 \ -cursor sb_h_double_arrow -relief raised -bd 1] -relx $relx \ -x -4 -relheight 1.0 set relx [expr {$relx + $relxPortion}] bind $win.sep$sepIndex <Button-1> "ctable::drawSlider:setInitialPosition %X" bind $win.sep$sepIndex <B1-Motion> "ctable::dragSlider %W $sepIndex %X" } set mapCmd {} if {[info exists cmdArgs(-height)] == 1} { append mapCmd "%W configure -height $cmdArgs(-height); " } else { append mapCmd "%W configure -height \[winfo height %W.f0\]; " } if {[info exists cmdArgs(-width)] == 1} { append mapCmd "%W configure -width $cmdArgs(-width)" } else { append mapCmd "%W configure -width \[expr {$cmdArgs(-columns) * 100}\]" } update idletasks bind $win <Map> $mapCmd rename $win _ctable$win proc $win {cmd args} { set self [lindex [info level 0] 0] set actWin _ctable$self if {$cmd == "config"} { set cmd configure } switch -- $cmd { configure { eval $actWin config $args } insert { if {[llength $args] != 3} { return -code error {invalid number of arguments: use .instance insert column row data} } set column [lindex $args 0] set row [lindex $args 1] set data [list [lindex $args 2]] eval $self.f$column.e$row insert 0 $data } } } return $win }
Test Code
#!/usr/local/bin/wish8.3 source ./ctable.tcl proc main {} { pack [ctable .t -columns 4 -rows 5] -side top -fill both #column 0 row 0 .t insert 0 0 {First Name} .t insert 1 0 {Last Name} .t insert 2 0 Job .t insert 3 0 {Primary Key} set i 1 foreach fname {Angelica Henry Richard John Jane} { .t insert 0 $i $fname incr i } set i 1 foreach lname {Smith Fresco Scorso Doe Doe} { .t insert 1 $i $lname incr i } set i 1 foreach job {Marketing Sales Projections {Information Systems} \ {Sanitation Engineer}} { .t insert 2 $i $job incr i } for {set i 1} {$i <= 5} {incr i} { .t insert 3 $i $i } } main
(Image link broken on Sep. 15, 2011)