Thread [Tk] Refresh Problem (9 answers)
Opened by a_abels at 2011-11-03 00:14

a_abels
 2011-11-06 12:58
#153948 #153948
User since
2010-07-11
90 articles
BenutzerIn
[default_avatar]
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:
more (34.0kb):

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)

View full thread [Tk] Refresh Problem