ctable

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

http://www.xmission.com/~georgeps/ctable/ctable_test.png (Image link broken on Sep. 15, 2011)