Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Re^2: TK spread sheet color row

by aviw (Acolyte)
on Jul 09, 2017 at 10:09 UTC ( [id://1194590]=note: print w/replies, xml ) Need Help??


in reply to Re: TK spread sheet color row
in thread TK spread sheet color row

Hi,

Thank you both.

I would prefer to use common TK way (-selcmd => sub{}) I do get click event yet it returns my ($NumRows,$Numcols,$selection,$noCells) = @_. based on: TableMatrix

When using -rowtagcommand I do get a call with correct row number (great!) yet I fail to find a way to color the row :/

Is the only solution is via TK:bind for each cell?

Replies are listed 'Best First'.
Re^3: TK spread sheet color row
by zentara (Archbishop) on Jul 09, 2017 at 12:14 UTC
    yet I fail to find a way to color the row

    Hi, you can try

    $t->tagRow('active', $row);
    and here is a full working example. Press the Update button to see it work.
    #!/usr/bin/perl use warnings; use strict; 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"} = "$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) ; } sub rowSub{ my $row = shift; return "Oddrow" if( $row > 0 && $row%2) ; } my $t = $mw->Scrolled('TableMatrix', -rows => $rows, -cols => $cols, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -coltagcommand => \&colSub, -colstretchmode => 'last', -rowtagcommand => \&rowSub, -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', -fg => 'red', -relief => 's +unken'); $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 { $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 }

    I'm not really a human, but I play one on earth. ..... an animated JAPH

      TY!

      I tried your version the taging is working :) but I get some issue with tagging again- once I select 3 rows than selecting one of the 3 rows again I don't get rowSub warn I add.

      Kindly see my minor modification (marked by the comment "ADDED"/"REMOVED" ) which I add for test of the usage I need - select each row multiple times & mark only selected row.

      >The issue can be seen when selected 4 rows than selecting one of the 3 prior rows again - the colSub method isn't being called.

      Could kindly you advise?, I don't understand what I'm missing.

      #.. remove the headers same as yours so msg will be shorter. 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"} = "$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', -rowtagcommand => \&rowSub, -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 => 'blue', -fg => 'red', -relief => 'su +nken'); $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); my $selected = -1; my $prev_selected = -1; sub update_table { #$t->tagCell('dis', '1,1' ); # REMOVED #$t->activate('2,2'); # REMOVED warn("\n\n\nprev_selected:'$prev_selected' , selected:'$select +ed'"); # ADDED $t->tagRow('active',$selected) if ($selected != -1); # ADDED $t->tagRow('OddCol',$prev_selected) if (defined $prev_selected + && $prev_selected != -1); # ADDED $prev_selected = $selected; # ADDED warn("\n\n\npost updated prev_selected:'$prev_selected' , sele +cted:'$selected'"); # $t->configure(-padx =>( $t->cget(-padx))); # a trick needed sometimes to update } sub rowSub{ my $row = shift; $selected = $row; # ADDED warn ("\n\nrowSub - row: $row"); # ADDED return "Oddrow" if( $row > 0 && $row%2) ; }
        Could kindly you advise?, I don't understand what I'm missing.

        Hi, I havn't used TableMatrix enough to answer offhand. From my understanding of tags on the Tk::Canvas I would bet that you need to use the -browsecmd and -selcmd callbacks to do some juggling of the tags. It may require complicated callbacks, maybe with arrays of rows which need their tags changed. Look at tags as something fluid, change tags, change them back, etc. Sometimes it takes a bit of contemplation to get it right. :-)


        I'm not really a human, but I play one on earth. ..... an animated JAPH

        Not Sovled yet, when updated the row:

         t->tagRow('OddCol',$prev_selected) if (defined $prev_selected && $prev_selected != -1); # ADDED

        TO:

         t->tagRow(undef,$prev_selected) if (defined $prev_selected && $prev_selected != -1); # ADDED

        Now can select same row again.BUT when select row 5 post selecting row 1 I get all rows 2,3,4,5 Why?\ Isn't there normal way to do this? Do I miss something?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1194590]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (5)
As of 2024-04-23 18:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found