@implementation TableBox { - init {} { $super init set counter 1 set separator {} $super hideBorder $frame configure -relief sunken -bd 1 frame $frame.f canvas $frame.f.headers -bd 0 -relief flat -width 10 -height 10 pack $frame.f.headers -fill both -expand 1 $frame.f.headers create window 0 0 \ -window [set headers [frame $frame.f.headers.frame -bd 0]] \ -anchor nw -tag headers canvas $frame.f.main -bd 0 -relief flat -width 10 -height 10 $frame.f.main create window 0 0 \ -window [set main [frame $frame.f.main.frame -bd 0]] \ -anchor nw -tag main set xscroll [scrollbar $frame.xscroll -orient horizontal \ -command "$self xview"] set yscroll [scrollbar $frame.yscroll -orient vertical \ -command "$self yview"] $frame.f.main configure -xscrollcommand [list $xscroll set] grid $frame.f $frame.yscroll -sticky snew -padx 0 -pady 0 grid $frame.xscroll -sticky snew -padx 0 -pady 0 grid rowconfigure $frame 0 -weight 1 grid columnconfigure $frame 0 -weight 1 grid $frame.f.headers -sticky snew -padx 0 -pady 0 grid $frame.f.main -sticky snew -padx 0 -pady 0 grid rowconfigure $frame.f 1 -weight 1 grid columnconfigure $frame.f 0 -weight 1 set callbacks(Selection) {} $self on: Configure do: { set w [eventData get: path] if {"$w" == "$frame.f.main.frame"} { $frame.f.main configure -scrollregion [set bbox [$frame.f.main bbox all]] $frame.f.headers configure -scrollregion $bbox } elseif {"$w" == "$frame.f.headers.frame"} { $frame.f.headers configure \ -height [winfo height $frame.f.headers.frame] } elseif {"$w" == "$frame.headers"} { $frame.f.headers configure \ -height [winfo height $frame.f.headers.frame] \ -scrollregion [$frame.f.headers bbox all] } elseif {"$w" == "$frame.f.main"} { $frame.f.main itemconfigure [$frame.f.main find withtag main] \ -height [winfo height $frame.f.main] $frame.f.main configure -scrollregion [set bbox [$frame.f.main bbox all]] $frame.f.headers configure -scrollregion $bbox } } $self enableEvent: Configure \ on: [list $frame.f.main.frame $frame.f.headers.frame \ $frame.f.main $frame.f.headers] $self on: ButtonPress-1 do: { $self rowOfSelection: [[eventData get: path] nearest [eventData get: y]] $self selectionChange } $self on: B1-Motion do: { $self rowOfSelection: [[eventData get: path] nearest [eventData get: y]] $self selectionChange } $self on: Button-4 do: { foreach column [pack slaves $main] { if {"[eventData get: path]" != "$column"} { $column yview scroll -5 units } } } $self on: Button-5 do: { foreach column [pack slaves $main] { if {"[eventData get: path]" != "$column"} { $column yview scroll +5 units } } } } - columns: columns { if [string length $separator] { foreach column [split $columns $separator] { $self addColumn: $column } } else { foreach column $columns { $self addColumn: $column } } } - columns {} { set columns {} foreach column [pack slaves $headers] { lappend columns [$column get 0 end] } if [string length $separator] { return [join $columns $separator] } else { return $columns } } - rowOfSelection: row { foreach column [pack slaves $main] { $column selection clear 0 end if [string length $row] { $column select anchor $row $column select set anchor $row set rowOfSelection $row } } } - rowOfSelection {} { return $rowOfSelection } - selection {} { return [$self row: $rowOfSelection] } - row: aRow { set result {} set columns [pack slaves $main] if {[llength $columns] == 0} { return } foreach column $columns { lappend result [$column get $i] } if [string length $separator] { return [join [string trimright $result \n] $separator] } else { return [string trimright $result \n] } } - addColumn: column { global tcl_platform set length [expr [string length $column] + 3] pack [listbox $headers.$counter -relief raised -bd 1 -width $length \ -height 1 -exportselection no \ -background [$frame.f.headers cget -bg] \ -selectbackground [$frame.f.headers cget -bg]] \ -side left -fill y -expand 1 -padx 0 -pady 0 $headers.$counter insert end $column pack [listbox $main.$counter -width $length -height 5 \ -relief raised -bd 1 \ -exportselection no -yscrollcommand [list $yscroll set]] \ -side left -fill y -expand 1 -padx 0 -pady 0 $headers configure -width [winfo reqwidth [winfo parent $headers]] $self enableEvent: {ButtonPress-1 B1-Motion Button-4 Button-5} \ on: $main.$counter incr counter } - add: record { set columns [pack slaves $main] if {[string length $separator]} { if {[llength [split $record $separator]] > [llength $columns]} { set record [join [lrange [split $record $separator] 0 [expr [llength $columns] -1]] $separator] } set items [split $record $separator] } else { if {[llength $record] > [llength $columns]} { set record [join [lrange $record 0 [expr [llength $columns] -1]]] } set items $record } foreach column $columns item $items { if {[set len [expr [string length $item] +3]] \ > [$column cget -width]} { $column configure -width $len $headers.[lindex [split $column .] end] configure -width $len } $column insert end $item } } - insert:atRow: {record row} { set columns [pack slaves $main] if {[string length $separator]} { if {[llength [split $record $separator] > [llength $columns]} { set record [join [lrange [split $record $separator] 0 [expr [llength $columns] -1]] $separator] } } else { if {[llength $record] > [llength $columns]} { set record [join [lrange $record 0 [expr [llength $columns] -1]]] } } foreach column $columns item [split $record $separator] { if {[set len [expr [string length $item] +3]] \ > [$column cget -width]} { $column configure -width $len $headers.[lindex [split $column .] end] configure -width $len } $column insert $row $item } } - deleteRow: row { foreach column [pack slaves $main] { $column delete $row $row } } - loadFromFile: aFile { if [catch {set f [open $aFile r]} err] { @error "$self loadFromFile: $aFile ($err)" return -1 } gets $f line if {[string length $separator]} { set len [llength [split $line $separator]] } else { set len [llength $line] } if {![string length [$self columns]]} { for {set i 1} {$i <= $len} {incr i} { $self addColumn: $i } } while {[eof $f] == 0} { gets $f line if [string length $line] { $self add: $line } } close $f } - content {} { set result {} set columns [pack slaves $main] if {[llength $columns] == 0} { return } for {set i 0} {$i < [[lindex $columns 0] size]} {incr i} { set line {} foreach column $columns { append line [$column get $i], } append result [string trimright $line ,]\n } return [string trimright $result \n] } - xview {args} { eval [winfo parent $headers] xview $args eval [winfo parent $main] xview $args } - yview {args} { foreach l [pack slaves $main] { eval $l yview $args } } - onSelection: aCallback { set callbacks(Selection) $aCallback } - onSelection {} { return $callbacks(Selection) } - selectionChange {} { catch {eval $callbacks(Selection)} } - separator {} { return $separator } - separator: _separator { set separator $_separator } - dealloc {} { catch {destroy $main $headers} return [$super dealloc] } }