## basic ## ## This demo shows the basic use of the table widget ## ## jeff.hobbs@acm.org use Tk; use Tk::TableMatrix; use Data::Dumper qw( DumperX); my $top = MainWindow->new; my $arrayVar = {}; foreach my $row (-1..6){ foreach my $col (-2..5){ $arrayVar->{"$row,$col"} = "r$row, c$col"; } } ## Test out the use of a callback to define tags on rows and columns sub rowSub{ my $row = shift; return "OddRow" if( $row > 0 && $row % 2) } sub colSub{ my $col = shift; return "OddCol" if( $col > 0 && $col%2) ; } my $label = $top->Label(-text => "TableMatrix v1 Example"); my $t = $top->Scrolled('TableMatrix', -rows => 8, -cols => 8, -width => 6, -height => 6, -titlerows => 1, -titlecols => 2, -variable => $arrayVar, -roworigin => -1, -colorigin => -2, -rowtagcommand => \&rowSub, -coltagcommand => \&colSub, -colstretchmode => 'last', -rowstretchmode => 'last', -selectmode => 'extended', -sparsearray => 0, ); my $button = $top->Button( -text => "Exit", -command => sub{ $top->destroy}); # hideous Color definitions here: $t->tagConfigure('OddRow', -bg => 'orange', -fg => 'purple'); $t->tagConfigure('OddCol', -bg => 'brown', -fg => 'pink'); $t->colWidth( -2 => 7, -1 => 7, 1=> 5, 2 => 8, 4=> 14); $label->pack( -expand => 1, -fill => 'both'); $t->pack(-expand => 1, -fill => 'both'); $button->pack(-expand => 1, -fill => 'both'); my $variable = $t->cget( -var); Tk::MainLoop;