File: table_demo

package info (click to toggle)
perl-tk 1:800.025-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,444 kB
  • ctags: 19,081
  • sloc: ansic: 206,740; perl: 40,187; makefile: 4,371; sh: 2,373; yacc: 762
file content (67 lines) | stat: -rwxr-xr-x 1,420 bytes parent folder | download | duplicates (5)
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/local/bin/perl -w

use Tk;
use Tk::Table;

sub Compass
{
 my ($top,$var) = @_;
 my $out = $top->Table(-relief => 'ridge',-borderwidth => 3,-scrollbars => 'c');
 my $i = 0;
 foreach $r ([qw(nw n ne)],[qw(w c e)],[qw(sw s se)])
  {
   my $j = 0;
   foreach $a (@$r)
    {
     $b = $out->Create($i,$j++,'Radiobutton',-text=> $a, 
                       -variable => $var, -value => $a, -anchor => 'w');
    }
   $i++;
  }
 return $out;
}

my $mw = MainWindow->new;

my $t  = $mw->Table(-columns => 6, -rows => 8, -fixedrows => 1, -scrollbars => 'se');
$t->pack(-expand=> 1, -fill => 'both');

sub Pressed
{
 my ($t,$i,$j) = @_;
 my $l = $t->Label(-text => "Pressed $i,$j",-relief => 'sunken');
 my $old = $t->put($i,$j,$l);
 $old->delete if ($old);
}

my $i;
foreach $i (0..9)
 {
  my $j;
  foreach $j (0..9)
   {
    my $l = $t->Button(-text => "Entry $i,$j",
                       -command => [\&Pressed,$t,$i,$j]);
    $t->put($i,$j,$l);
   }
 }

my $sb;
my $rl;
my $cl;

tie $sb,Tk::Configure,$t,'-scrollbars';
tie $rl,Tk::Configure,$t,'-fixedcolumns';
tie $cl,Tk::Configure,$t,'-fixedrows';

Compass($mw,\$sb)->pack(-side => 'bottom');

$mw->Checkbutton(-text => 'Row labels', -variable => \$rl, -onvalue => 1, -offvalue => 0)
 ->pack(-side => 'left'); 
$mw->Checkbutton(-text => 'Column labels', -variable => \$cl, -onvalue => 1,-offvalue => 0)
 ->pack(-side => 'right'); 

$t->focus;
$t->update;

MainLoop;