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
sub splash_screen {
Tkx::package_require('img::gif');
my $top = Tkx::widget->new(q{.});
$top->g_wm_withdraw();
my $splash = $top->new_tkx_SplashScreen(
-image => 'kv_gif_obj',
-width => 'auto',
-height => 'auto',
-show => 1,
-topmost => 1,
);
my $canvas = $splash->canvas();
$canvas->create_text( 110, 20, -text => 'ZUGANG', -fill => 'blue', );
my ( $w, $h ) = ( $canvas->cget( -width ) / 100, $canvas->cget( -heigh ) - 20 );
_progress_bar( $canvas, $h, $w * 33 );
Tkx::after( 1000 => sub { _progress_bar( $canvas, $h, $w * 66 ); } ;
# --- Online-Verbindung testen
$OS{onlinetest} = online_test_via_http(%PROXY);
Tkx::after( 5000 => sub { _progress_bar( $canvas, $h, $w * 100 ); } );
# --- Prüfen ob Updates vorhanden sind
if ( $OS{onlinetest} == 1 ) { ( $OS{updatetest}, $OS{updatetext} ) = update_test( $VERSION, $UPDATE, %PROXY );
}
else {
$OS{updatetest} = q{};
}
Tkx::after( 8000 => sub { $splash->g_destroy(); $top->g_wm_deiconify(); });
return;
}
sub _progress_bar {
my ( $canvas, $h, $w ) = @ARG;
$canvas->create_line( 0, $h, $w, $h, -fill => 'green', -width => 20 );
Tkx::update();
return;
}