Thread [Tk] Refresh Problem
(9 answers)
Opened by a_abels at 2011-11-03 00:14
Jetzt bin ich schon ein Stück(chen) weiter. Ich weiß nur nicht, warum nach ca. 3 Durchläufen der Banner immer langsamer wird. Habe ich habe da irgendwo ein Fehler?
Hier das lauffähige Programm: Code (perl): (dl
)
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 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 #!/usr/bin/perl use strict; use warnings; use Tk; use Time::HiRes qw(usleep); our $DEBUG = 0; foreach my $ARG (@ARGV) {print "'$ARG'\n" if $DEBUG}; my %variable; my $disappear; my $id = $ARGV[0];; my $title = $ARGV[1]; my $params = $ARGV[2]; my @ini_parameters = split ";", $params; foreach my $string (@ini_parameters) { # get all variables and their values $string =~ /(.*)=(.*)/; $variable{$1} = $2; print "variable:'$1' - value:'$2'\n" if $DEBUG; } my ( $label, $host, $bannerspeed ); our( $font, $fontsize, $fonttype, $fgcolor, $bgcolor ); if ( $variable{'title'} ) { $title = $variable{'title'} } else { $title = "Message:" }; if ( $variable{'label'} ) { $label = $variable{'label'} } else { $label = "no label defined" }; if ( $variable{'font'} ) { $font = $variable{'font'} } else { $font = "Arial" }; if ( $variable{'fontsize'} ) { $fontsize = $variable{'fontsize'} } else { $fontsize = "30" }; if ( $variable{'fonttype'} ) { $fonttype = $variable{'fonttype'} } else { $fonttype = "bold" }; if ( $variable{'fgcolor'} ) { $fgcolor = $variable{'fgcolor'} } else { $fgcolor = "black" }; if ( $variable{'bgcolor'} ) { $bgcolor = $variable{'bgcolor'} } else { $bgcolor = "red" }; if ( $variable{'host'} ) { $host = $variable{'host'} } else { $host = "localhost" }; if ( $variable{'bannerspeed'} ) { $bannerspeed = $variable{'bannerspeed'} } else { $bannerspeed = "1" }; our $fonts = $font." ".$fontsize." ".$fonttype; $fonts =~ s/^\s+//; $fonts =~ s/\s+$//; our $mw = MainWindow->new; $mw->title($title); # calculate max windows size my ($max_window_width,$max_window_height)=$mw->maxsize(); our $window_size_x = $max_window_width; our $window_size_y = $fontsize+20; our $window_position_x = 0; our $window_position_y = $id * ($window_size_y + 34); my $text_position_x = 0; my $text_position_y = 0; # Mainwindow: sizex/y, positionx/y $mw->geometry($window_size_x."x".$window_size_y."+".$window_position_x."+".$window_position_y); banner(" " x $max_window_width, $text_position_x, $text_position_y); # open windows first time to set background color #prevents mw from closing #$mw->protocol('WM_DELETE_WINDOW' => sub { Funct(); exit;} ); my $label_length = length($label); my ($pre_label, $post_label, $new_label, $min_x, $starttime); $min_x = (($label_length + 30) * (-1)) * ($fontsize / 2); # message went of screen on left side #$pre_label = " " x $loop; $post_label = " " x $bannerspeed; $new_label = $label.$post_label; for (my $loop = $max_window_width; $loop >= $min_x; $loop = $loop - $bannerspeed) { if ( $loop == $max_window_width ) { $starttime = time }; # print "'$new_label', '$loop', '$text_position_y'\n" if $DEBUG; banner($new_label, $loop, $text_position_y); if ( $loop <= $min_x ) { my $duration = time - $starttime; $starttime = time; print "duration:'$duration' - length:'",length($new_label),"'\n"; $loop = $max_window_width; }; usleep(5); } #automatic close after time $mw->after(1000, sub { $mw->destroy; }); #MainLoop; exit; ################################################### ################################################### ################################################### sub banner { my $label = shift; my $text_position_x = shift; my $text_position_y = shift; $mw->Label( -fg=> $fgcolor, -bg => $bgcolor, -text => $label, -font => $fonts) -> place (-x => $text_position_x, -y => $text_position_y); $mw->update; } mfg André modedit Editiert von pq: perl-tags hinzugefügt Last edited: 2011-11-06 14:31:55 +0100 (CET) |