#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::TableMatrix;
use Tk::TableMatrix::Spreadsheet;
my $top = MainWindow->new;
my $arrayVar = {};
print "Filling Array...\n";
my ($rows,$cols) = (40000, 10);
foreach my $row (0..($rows-1)){
$arrayVar->{"$row,0"} = "$row";
}
foreach my $col (0..($cols-1)){
$arrayVar->{"0,$col"} = "$col";
}
print "Creating Table...\n";
sub colSub{
my $col = shift;
return "OddCol" if( $col > 0 && $col%2) ;
}
my $label = $top->Label(-text => "TableMatrix v2 Example")
->pack( -expand => 1, -fill => 'both');
my $t = $top->Scrolled('Spreadsheet',
-rows => $rows,
-cols => $cols,
-width => 6,
-height => 12,
-titlerows => 1,
-titlecols => 1,
-variable => $arrayVar,
-coltagcommand => \&colSub,
-colstretchmode => 'last',
-flashmode => 1,
-flashtime => 2,
-wrap=>1,
-rowstretchmode => 'last',
-selectmode => 'extended',
-selecttype=>'cell',
-selecttitles => 0,
-drawmode => 'slow',
-scrollbars=>'se',
-sparsearray=>0
)->pack(-expand => 1, -fill => 'both');
#my $realmatrix = $t->Subwidget('scrolled');
$top->Button( -text => "Show Selected",
-command => sub{
print $t->curselection(),"\n";
})->pack(-expand => 1, -fill => 'x');
$top->Button( -text => "Clear",
-command => sub{&clear})->pack(-expand => 1, -fill => 'x');
$top->Button( -text => "Fill",
-command => sub{&fill})->pack(-expand => 1, -fill => 'x');
$top->Button( -text => "Exit",
-command => sub{$top->destroy})->pack(-expand => 1, -fill => 'x'
+);
$t->colWidth( -2 => 8, -1 => 9, 0=> 12, 4=> 14);
$arrayVar->{"1,1"} = 42;
Tk::MainLoop;
######################################################################
+####
sub TMRefresh {
#Required input TableMatrix object.
#use to force matrix to update, a code trick
return if (!$_[0]);
$_[0]->configure(-padx =>($_[0]->cget(-padx)));
#$realmatrix->update;
#$t->update;
#$top->update;
#$t->see("100,100"); #trick to force update?
#$t->see("end");
#$t->see("1,1");
}
######################################################################
+###
sub clear{
#$t->clearAll('0,0','end');
foreach my $row(1..$rows){
foreach my $col(1..$cols){
$arrayVar->{"$row,$col"} = 0;
}
}
&TMRefresh($t);
}
######################################################################
+####
sub fill{
foreach my $row(1..$rows){
foreach my $col(1..$cols){
$arrayVar->{"$row,$col"} = 1000;
}
}
&TMRefresh($t);
}
############################################
| [reply] [d/l] |
Thanks for the help. Your mention of the modified cell value being automatically saved got me back on track. I had come across mention of that earlier in my project, but for whatever reason, seemed to be mixing the hash reference and dataArray variables I was using in different portions of my code. Anyway, I've got it sorted.
On another note, could you or any of the other monks point me to a good GUI layout reference? I'm using a mix of the spreadsheet, frames, and a canvas, but don't have the control I'd like as to the exact placement of widgets. This is likely due to my inexperience with Tk, but would like something maybe with absolute positions.
Cheers.
| [reply] |
point me to a good GUI layout reference .... maybe with absolute positions
Well , google for perl Tk geometry tutorial and there are the chapters from the books, Learning Perl Geometry Management and Mastering Perl/Tk Geometry Management. If you want absolute placement, it sounds like you are looking for the place() or form() manager, which are seldom used. The problem with those managers is they are
trickier to get consistent results when a window resize occurs, but that may not be a problem for you.
| [reply] |
So curvalue/get not working for you?
Try the diagnostical Tk::ObjScanner and Tk::WidgetDump
install cpanp -i Tk::ObjScanner Tk::WidgetDump
and use
use Tk::ObjScanner;
use Tk::WidgetDump;
Tk::ObjScanner::scan_object(
{
q{tablematrix} => $yourTableMatrix,
}
);
$mw->WidgetDump;
| [reply] [d/l] [select] |