#!/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"} = 2*$row + 3*$col; } } print "Creating Table...\n"; 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' ); $t->pack(-expand => 1, -fill => 'both'); $mw->Button( -text => "Show Selected", -command => sub{ print $t->curselection(),"\n"; })->pack(-expand => 1, -fill => 'x'); Tk::MainLoop; sub brscmd { my ($previous_index, $actual_index) = @_; my ($row, $col) = split ',', $actual_index; my ($sel, $js); $sel = $t->curselection(); print "@$sel\n"; #didn't do much #$t->set('active',@$sel); &get_active(); &TMRefresh($t); foreach $js (@$sel) { print "\n[brscmd] actual index <$actual_index> from curselection <$js>\n"; } } sub get_active{ &TMRefresh($t); my @active = @{$t->curselection()}; print "active-> @active\n"; } sub TMRefresh { #Required input TableMatrix object. #use to force matrix to update, a code trick return if (!$_[0]); $_[0]->configure(-padx =>($_[0]->cget(-padx))); }