Tk::ProgressBar - Fortschrittsbalken

Zur Fortschrittsanzeige kann der Tk::ProgressBar verwendet werden. Das Widget kann beispielsweise benutzt werden, um einem Benutzer Rückmeldung über einen Hintergrundprozess anzuzeigen.

Das Code-Beispiel verwendet dazu Tk::After. Jede Sekunde wird eine Sub aufgerufen. Wenn der Balken voll ist, wird die Wiederholung beendet.

#!perl

use strict;
use warnings;
use utf8;
use Tk;
use Tk::ProgressBar;
use Tk::After;

# Ein neues Hauptfenster erzeugen:
my $mw = Tk::MainWindow->new(
	-width => 160,
	-height => 120,
);
$mw->packPropagate(0);

my $percent_done = 0;
my $progress = $mw->ProgressBar(
	-width => 20,
	-length => 200,
	-from => 0,
	-to => 100,
	-blocks => 10,
	-colors => [0, 'green', 50, 'yellow' , 80, 'red'],
	-variable => \$percent_done
)->pack(-fill => 'both', -expand => 1,);


# Button erstellen:
my $repeat_id = undef;
my $but1 = $mw->Button(
	-text => "Progressbar vollaufen lassen", 
	-command => sub{
		# nur ausführen, wenn nicht sowieso gerade eine 
		# WDH läuft
		unless( defined $repeat_id ) {
		  # starte Wiederholdung
		  $repeat_id = $progress->repeat( 1000, sub{
		  	my $val = $progress->value();
		  	my $max = $progress->cget('-to');
		  	# es läuft bereits eine WDH
		  	if( $val >= $max ) {
		  		print "balken ist voll\n";
		  		# Balken ist voll, dann 
		  		# stoppe WDH
		  		$repeat_id->cancel();
		  		# lösche Info über WDH
		  		$repeat_id = undef;
		  	}else{
		  		print "$val = nicht voll\n";
		  		# Balken ist noch nicht voll
		  		my $new_value = $val + int( $max / 10 );
		  		$progress->value($new_value);
		  		$mw->update();
		  	}
		  	return;
		  });
		}
		
		return;
	},
)->pack(-fill => 'x');

# Button erstellen:
my $but2 = $mw->Button(
	-text => "Progressbar auf 0 setzen", 
	-command => sub{
		$progress->value($progress->cget('-from'));
	},
)->pack(-fill => 'x');


# Tk-Eventloop starten:
$mw->MainLoop();
exit(0);


sub empty_bar {
	my $bar = shift;
	$bar->value(0);
	return;
} # empty_bar
Top