Tk::Table - einfache zweidimensionale Tabellen

Tk::Table stellt einfache zweidimensionale Tabellen dar. Es handelt sich eher um eine Art Geometriemanager - also eine Hilfe zur Ausrichtung von Widgets in einem zweidimensionalen Raum. Daraus folgt der relativ begrenzte Funktionsumfang.

Solche Dinge wie Zellen, die sich über mehrere Zeilen / Spalten erstrecken sind mit diesem Widget nicht möglich. Wer das braucht sollte sich Tk::TableMatrix::Spreadsheet ansehen. Man kann allerdings Zeilen und Spalten fixieren, also als Kopfzeile festlegen.


Methoden

Es gibt im Wesentlichen zwei Methoden, die von Interesse sind: put() und clear().

put($zeile, $spalte, $inhalt) weist einer Zelle einen Inhalt zu. Das kann entweder ein banaler String sein, oder ein beliebiges Widget. Im Falle einer Zeichenkette wird dafür automatisch ein Label erzeugt und dieses angezeigt.

Die Breite einer Spalte wird übrigens automatisch errechnet und richtet sich immer nach dem breitesten Widget. Es ist nicht möglich, die Breite über einen Parameter festzulegen.

Dieser Behelt zeigt, wie ein Button in Zeile 2 und Spalte 4 einer Tabelle $tab eingefügt wird:

my $btn = $tab->Button(
        -text => 'Klick mich NICHT an!',
        -command => sub{ exit(0); },
);
$tab->put(1,2,$btn);

clear() entfernt alle Inhalte aus der Tabelle. Alle Widgets die in der Tabelle enthalten waren werden zerstört.

Beispiel: Tabelle mit auswählbaren Zellen

Im Folgenden sehen Sie ein Beispiel, das eine Tabelle in Perl/Tk erstellt und es ermöglicht, Zellen durch Anklicken auszuwählen bzw. die Auswahl aufzuheben:

#!perl

use strict;
use warnings;
use Tk;
use Tk::Table;

#
# The following is an example of Tk/Perl that creates a Table and allows you 
# to select/de-select cells by clicking on them.
# Based on http://www.pgts.com.au/cgi-bin/psql?blog=0806&ndx=b011 downloaded 2014-10-20
#

# ------------------------------------------------------------------------

my $cols = 10;
my $rows = 20;

# global variable holding the selected rows
my %slct = ();

# ------------------------------------------------------------------------

#
# create the main window and frame
#
my $mw = new MainWindow();
my $table_frame = $mw->Frame(
	-borderwidth => 2,
	-relief => 'raised'
)->pack( -fill => 'both', -expand => 1, );

#
# allocate a table to the frame
#
my $table = $table_frame->Table(
	-columns => 8,
	-rows => 10,
	-fixedrows => 1,
	-scrollbars => 'se',
	-relief => 'raised',
);

#
# column headings
#
foreach my $c ( 1 .. $cols) {
	my $hdr = "Row " . $c;
	my $tmp = $table->Label(
		-text => $hdr,
		-width => 6,
		-relief => 'raised',
	);
	$table->put( 0, $c, $tmp );
}

#
# populate the cells and bind an action to each one
#
foreach my $r ( 1 .. $rows ) {
	foreach my $c ( 1 .. $cols ) {
		my $data = $r . "," . $c;
		my $tmp = $table->Label(
			-text => $data, -padx => 2,
			-anchor => 'w',
			-background => 'white',
			-relief => 'groove',
		);
		$tmp->bind('<Button>', [ \&toggle_slct, $table ]);
		$table->put( $r, $c, $tmp );
	}
}
$table->pack( -expand => 'yes', -fill => 'both');

#
# create the menu bar, and add the "show" and "exit" buttons
#
my $button_frame = $mw->Frame( -borderwidth => 4 )->pack(-fill => 'y');
my $show_btn = $button_frame->Button(
	-text => "Show",
	-command => \&show_cells
);
my $exit_btn = $button_frame->Button(
	-text => "Exit",
	-width => 10,
	-command => sub { exit },
);
foreach ( $show_btn, $exit_btn ) {
    $_->pack(-side => 'left', -padx => 2 );
}

#
# start it up
#
$mw->MainLoop();
exit(0);


# ------------------------------------------------------------------------

sub show_cells {
	print "Selected Cells: ";
	foreach ( sort {$a <=> $b} (keys %slct)) {
		printf "%d,%d ",split (/\./,$_);
	}
	print "\n";
}

# ------------------------------------------------------------------------

sub toggle_slct {
	my ($w, $t) = @_;
	my ($row, $col) = $t->Posn( $w );
	my $k = sprintf "%d.%02d",$row,$col;
	if ($slct{$k}) {
		$w->configure(-background => 'white');
		print "Row: $row Col: $col unselected\n";
		delete($slct{$k});
	} else {
		$w->configure(-background => 'grey');
		print "Row: $row Col: $col selected\n";
		$slct{$k} = 1;
	}
}

Beispiel: Windows-Prozesse anzeigen

Nachfolgendes Beispiel zeigt eine Anwendung als echte Tabelle. Die Prozesse eines Windows-Betriebssystems werden ausgelesen und tabellarisch dargestellt. Das Ergebnis sieht wie folgt aus:

Tk::Table mit einer Liste von Windows-Prozessen

#!perl

use utf8;
use v5.12;
use strict;
use warnings;
use warnings  qw(FATAL utf8);
use open      qw(:std :utf8);
use charnames qw(:full :short);
use FileHandle;
use Data::Dumper qw/Dumper/;
use Tk;
use Tk::Table;
use Win32::Process::Info;

# auf die Schnelle ein Fenster erzeugen
my $mw = tkinit();

# Tabelle erstellen,
# 20 Zeilen und 3 Spalten sollen angezeigt werden.
my $table = $mw->Table(
	-columns => 3,
	-rows => 20,
	-fixedrows => 1,
	-scrollbars => 'se',
	-relief => 'raised',
);

# Titelzeilen erstellen
$table->put(0,0, header_label('Process ID'));
$table->put(0,1, header_label('Name'));
$table->put(0,2, header_label('Executable Path'));

# Inhalt einfügen (Liste aller Prozesse)
fill_process_table( $table );

# Tabelle anzeigen
$table->pack(-fill => 'both', -expand => 1,);

# Ereignisschleife von Perl/Tk starten
$mw->MainLoop();
exit(0);



=head2 header_label( $text )

Erzeugt ein Label für die Titelzeile.

=cut

sub header_label {
	my $text = shift;
	
	my $tmp = $table->Label(
		-text => $text,
		-relief => 'raised',
	);
	
	return $tmp;
} # /header_label




=head2 header_label( $text )

Erzeugt ein Label für normale Tabellen-Zellen. 
Es hat schware Schrift auf weißem Hintergrund.

=cut

sub content_label {
	my $text = shift;
	
	my $label = $table->Label(
		-text => $text,
		-padx => 2,
		-anchor => 'w',
		-background => 'white',
		-relief => 'groove',
	);
	
	return $label;
} # /content_label




=head2 fill_process_table( $table )

Liest alle Prozesse aus und fügt sie in die Tabelle ein.

=cut

sub fill_process_table {
	my $tbl = shift;
	
	my $pi = Win32::Process::Info->new();
	my @info = $pi->GetProcInfo();
	
	my $row = 1;
	for my $pid ( @info ) {
		$tbl->put($row, 0, content_label($pid->{'ProcessId'}));
		$tbl->put($row, 1, content_label($pid->{'Name'}));
		$tbl->put($row, 2, content_label(exists $pid->{'ExecutablePath'} ? $pid->{'ExecutablePath'} : ''));
		
		$row++;
	}
	
	return;
} # /fill_process_table

Dieses Beispiel zeigt kurz und knapp, wie Inhalte in eine Tk::Table eingefügt werden können. Das Ergebnis sind drei Widgets (2 Labels und 1 Button).

Tk::Table mit Labels und Button

#!perl

use strict;
use warnings;
use Tk;
use Tk::Table;

my $mw = Tk::MainWindow->new(
    -width  => 450,
    -height => 400,
    -title  => 'Tk::Table - Beispiel',
);
$mw->packPropagate(0);

# Tabelle erzeugen
my $t = $mw->Table(
    -width      => 200,
    -height     => 450,
    -rows       => 20,
    -columns    => 4,
    -scrollbars => 'se',
);

# Text in Zeile 0, Spalte 0 einfügen (0,0 = oben links)
$t->put(0, 0, 'Text');

# Label in Zeile 4, Spalte 3 einfügen
my $label = $t->Label(
    -text => 'Hervorhebung',
    -fg => 'red',
    -bg => 'blue',
    -font => '*-helvetica-bold-r-*-*-*-240-*-*-*-*-*-*',
);
$t->put(4, 3, $label);

# Button in Tabelle einfügen
$t->put(1,2,$t->Button(
    -text => 'Klick mich NICHT an!',
    -command => sub{ exit(0); },
));

$t->pack(-fill => 'both', -expand => 1,);

$mw->MainLoop();

Zum Schluss bleibt noch ein eher sinnfreies Beispiel:

Tk::Table

#!perl

use strict;
use warnings;
use Tk;
use Tk::Table;

my $mw = Tk::MainWindow->new(-width => 200, -height => 200,);
$mw->packPropagate(0);

my $t = $mw->Table(
    -width  => 100,
    -height => 150,
    -scrollbars => 'se',
);

for( my $c = 0; $c < 100; $c++ ) {
    $t->put($c, $c+2, $c);
    $t->put($c, $c+4, $c*100);
    $t->put($c, $c+6, $c^17);
    $t->put($c, $c*5, $c/5);
}

$t->pack(-fill => 'both', -expand => 1,);

$mw->MainLoop();

Quellen

Top