1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
#!/usr/bin/perl
## 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;
|
