lil_v has asked for the wisdom of the Perl Monks concerning the following question:

Hi guys, I'm trying to create a data table on perl Tk. I want to disable some cells based on the values entered on the previous cells. I'm not sure if that is possible so I created a button so the user can click after he enters all his values and then, it would disable the unwanted cells. Eventhough that would be useless, I still can't seem to disable those cells. Also, I want to link the text variables to a pop-up help window. My code is:
use Tk; use Tk::TableMatrix; use Tk::Text; use Tk::Dialog; use Data::Dumper qw( DumperX); my $mw = MainWindow->new; $nst = 3; my $arrayVar = {}; foreach my $row (0..10){ foreach my $col (0..$nst){ $arrayVar->{"0,0"} = "Variables"; #link to pop-up help window $arrayVar->{"0,$col"} = "r".($col/2+.5); if ($col%2 == 0) { $arrayVar->{"0,$col"} = "s".($col/2); } } } $mw->Button(-text => "Update", -command => \&update_table)->pack(-side + => 'bottom', -anchor => 'w'); my $t = $mw->Scrolled('TableMatrix', -rows => 10, -cols => $nst, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -selectmode => 'extended', -resizeborders => 'both', -titlerows => 1, -titlecols => 1, -bg => 'white', # -state => 'disabled' # -colseparator => "\t", # -rowseparator => "\n" ); $t->tagConfigure('active', -bg => 'gray90', -relief => 'sunken'); $t->tagConfigure( 'title', -bg => 'gray85', -fg => 'black', -relief => + 'sunken'); # $t->bind("<Any-Enter>", sub { $t->focus }); $t->pack(-expand => 1, -fill => 'both'); Tk::MainLoop; sub update_table { if ($arrayVar->{"6,$col"} == 1) { $arrayVar->{"7..9,$col"}->tagConfigure(-state => 'normal'); $arrayVar->{"7..9,$col"}->tagConfigure(-state => 'disabled'); $arrayVar->{"7..9,$col"}->tagConfigure(-state => 'disabled'); } # foreach my $row (1..10){ # foreach my $col (1..$nst){ # unless ($arrayVar->{"$row,$col"} =~ /[0-9]+/) { # $D = $mw->Dialog( # -title => 'Warning', # -text => "Please enter a valid number for $row,$col +!\n", # -font => 'Times 10', # -default_button => 'OK'); #$D->bell; #$D->Show; # } # } # } }
Any suggestions?

Replies are listed 'Best First'.
Re: Tk ::TableMatrix
by zentara (Cardinal) on Jul 01, 2008 at 16:23 UTC
    Your code didn't run for me, so I provided a similar working example. Your biggest mistake is
    $arrayVar->{"7..9,$col"}->tagConfigure(-state => 'normal'); # you are trying to call a method from a cell...won't work # it must be on the table $t->tagConfigure(........); # read the docs
    A working example, the syntax is very finicky, read the docs and experiment until you get it.
    #!/usr/bin/perl use Tk; use Tk::TableMatrix; my $mw = MainWindow->new; my $arrayVar = {}; print "Filling Array...\n"; my ($rows,$cols) = (4, 10); foreach my $row (0..($rows-1)){ foreach my $col (0..($cols-1)){ $arrayVar->{"$row,$col"} = "$row,$col"; } } print "Creating Table...\n"; ## Test out the use of a callback to define tags on rows and columns sub colSub{ my $col = shift; return "OddCol" if( $col > 0 && $col%2) ; } my $t = $mw->Scrolled('TableMatrix', -rows => $rows, -cols => $cols, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -coltagcommand => \&colSub, -colstretchmode => 'last', -rowstretchmode => 'last', -selectmode => 'extended', -selecttitles => 0, -drawmode => 'slow', -scrollbars=>'se' ); $mw->Button(-text => "Update", -command => \&update_table) ->pack(-side => 'bottom',-anchor => 'w'); # Color definitions here: $t->tagConfigure('active', -bg => 'white', -relief => 'sunken'); $t->tagConfigure('OddCol', -bg => 'lightyellow', -fg => 'black'); $t->tagConfigure('title', -bg => 'lightblue', -fg => 'black', -relief +=> 'sunken'); $t->tagConfigure('dis', -state => 'disabled'); $t->pack(-expand => 1, -fill => 'both'); $t->focus; Tk::MainLoop; # $t->tagConfigure($anchor, -anchor => $anchor); # $t->tagRow($anchor, ++$i); # $t->set( "$i,$first",$anchor); sub update_table { print "1\n"; $t->tagCell('dis', '1,1' ); $t->activate('2,2'); $t->tagRow('active',3); # $t->configure(-padx =>( $t->cget(-padx))); # a trick needed sometimes to update scrollbars # if adding columns or rows }

    I'm not really a human, but I play one on earth CandyGram for Mongo
      thx u...I needed a good working example. I stil want to know two things, is it poosible to link one of the titles to a pop up window? The other question is that, in the sub update_table, I wanted an if statement that would analyze one row and disable the cells beneath the row depending on their values. For example,
      foreach my $col (1..4){ if ($arrayVar->{"6,$col"} == 1) { $t->tagCell('dis','7,$col'); $t->tagCell('dis','8,$col'); $t->tagCell('dis','9,$col'); } }
      This code doesn't work and i've tried several variations to it. I'm running out of luck...
        I'm not terribly good with TableMatrix, but you could add a browsecmd, and test the column or row, and popup if your col,row condition is met. I just tested this and it seems the titles take the 0 row and 0 column. So you could test if the click is on a title, by detecting a 0 row or column.
        # table option -browsecommand => \&brscmd, sub brscmd { my ($previous_index, $actual_index) = @_; my ($row, $col) = split ',', $actual_index; print "r$row c$col\n"; # popup if row,col meets some criteria }
        you can do the disabling too, but it is a little tricky, because you have to raise the 'dis' tag over the 'OddCol' tag. You don't have this problem if you don't use the -coltagcommand option.
        #!/usr/bin/perl use Tk; use Tk::TableMatrix; my $mw = MainWindow->new; my $arrayVar = {}; print "Filling Array...\n"; my ($rows,$cols) = (10, 10); foreach my $row (0..($rows-1)){ foreach my $col (0..($cols-1)){ $arrayVar->{"$row,$col"} = 2*$row + 3*$col; } } print "Creating Table...\n"; ## Test out the use of a callback to define tags on rows and columns sub colSub{ my $col = shift; return "OddCol" if( $col > 0 && $col%2) ; } my $t = $mw->Scrolled('TableMatrix', -rows => $rows, -cols => $cols, -width => 10, -height => 10, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -coltagcommand => \&colSub, -browsecommand => \&brscmd, -colstretchmode => 'last', -rowstretchmode => 'last', -selectmode => 'extended', -selecttitles => 0, -drawmode => 'slow', -scrollbars=>'se' ); $mw->Button(-text => "Update", -command => \&update_table) ->pack(-side => 'bottom',-anchor => 'w'); $mw->Button(-text => "Disable", -command => \&dis_table) ->pack(-side => 'bottom',-anchor => 'w'); # hideous Color definitions here: $t->tagConfigure('active', -bg => 'white', -relief => 'sunken'); $t->tagConfigure('OddCol', -bg => 'lightyellow', -fg => 'black'); $t->tagConfigure('title', -bg => 'lightblue', -fg => 'black', -relief +=> 'sunken'); $t->tagConfigure('dis', -state => 'disabled', -bg => 'black'); $t->pack(-expand => 1, -fill => 'both'); $t->focus; Tk::MainLoop; sub update_table { print "1\n"; $t->tagCell('dis', '1,1' ); $t->tagRaise('dis', 'OddCol'); # only needed if coltagcommand used $t->activate('2,2'); $t->tagRow('active',3); # $t->configure(-padx =>( $t->cget(-padx))); # a trick needed sometimes to update } sub brscmd { my ($previous_index, $actual_index) = @_; my ($row, $col) = split ',', $actual_index; print "r$row c$col\n"; } sub dis_table{ print "2\n"; foreach my $col (1..4){ if ($arrayVar->{"6,$col"} >= 1) { print "col->$col\n"; $t->tagCell('dis',"7,$col"); $t->tagCell('dis',"8,$col"); $t->tagCell('dis',"9,$col"); } } $t->tagRaise('dis', 'OddCol'); # only needed if coltagcommand used }

        I'm not really a human, but I play one on earth CandyGram for Mongo