—package
Tkx::SplashScreen;
use
strict;
use
warnings;
our
$VERSION
=
'0.16'
;
use
Tkx;
__PACKAGE__->_Mega(
'tkx_SplashScreen'
);
__PACKAGE__->_Config();
#----------------------------------------------------------------------------
# Method : _Populate
# Purpose : Create a new splash screen
# Notes :
#----------------------------------------------------------------------------
sub
_Populate {
my
(
$class
,
$widget
,
$path
,
%opt
) =
@_
;
my
$self
=
$class
->new(
$path
)->_parent->new_toplevel(
-name
=>
$path
,
-class
=>
'tkx_SplashScreen'
);
$self
->_class(
$class
);
# Withdraw window
$self
->g_wm_withdraw();
# Data
my
$data
=
$self
->_data();
$data
->{-title} =
delete
$opt
{-title};
$data
->{-image} =
delete
$opt
{-image};
$data
->{-
override
} =
defined
$opt
{-
override
} ?
$opt
{-
override
} : 1;
$data
->{-width} =
defined
$opt
{-width } ?
$opt
{-width} : 400;
$data
->{-height} =
defined
$opt
{-height} ?
$opt
{-height} : 300;
$data
->{-alpha} =
defined
$opt
{-alpha} ?
$opt
{-alpha} : 1.0;
$data
->{-show} =
defined
$opt
{-show} ?
$opt
{-show} : 1;
$data
->{-posx} =
defined
$opt
{-posx} ?
$opt
{-posx} : -1;
$data
->{-posy} =
defined
$opt
{-posy} ?
$opt
{-posy} : -1;
$data
->{-hideonclick} =
defined
$opt
{-hideonclick} ?
$opt
{-hideonclick} : 0;
$data
->{-topmost} =
defined
$opt
{-topmost} ?
$opt
{-topmost} : 0;
$data
->{-delay} =
defined
$opt
{-delay} ?
$opt
{-delay} : 0;
# Initialize
$self
->_obj_init();
# Widget
return
$self
;
}
#----------------------------------------------------------------------------
# Method : _obj_init
# Purpose : Initializes splashscreen
# Notes :
#----------------------------------------------------------------------------
sub
_obj_init {
my
(
$self
) =
@_
;
my
$data
=
$self
->_data();
# Title
if
(
defined
$data
->{-title}) {
$self
->g_wm_title(
$data
->{-title});
}
# Override redirect
if
(
$data
->{-
override
}) {
$self
->g_wm_overrideredirect(1);
}
# Alpha channel
if
(
$data
->{-alpha}) {
if
(Tkx::tk_windowingsystem() eq
'win32'
) {
$self
->g_wm_attributes(
-alpha
=>
$data
->{-alpha});
}
}
# Topmost
if
(
$data
->{-topmost}) {
$self
->g_wm_attributes(
-topmost
=>
$data
->{-topmost});
}
# Fullscreen
if
(
$data
->{-fullscreen}) {
$self
->g_wm_attributes(
-fullscreen
=>
$data
->{-fullscreen});
}
# Set width/height
my
(
$image_width
,
$image_height
);
my
(
$width
,
$height
);
if
(
$data
->{-image}) {
$image_width
= Tkx::image_width(
$data
->{-image});
$image_height
= Tkx::image_height(
$data
->{-image});
}
else
{
$image_width
= 400;
$image_height
= 300;
}
if
((
$data
->{-width} eq
'auto'
) or (
$data
->{-width} < 0)) {
$width
=
$image_width
;
}
else
{
$width
=
$data
->{-width};
}
if
((
$data
->{-height} eq
'auto'
) or (
$data
->{-height} < 0)) {
$height
=
$image_height
;
}
else
{
$height
=
$data
->{-height};
}
# Set position
my
(
$posx
,
$posy
);
if
((
$data
->{-posx} eq
'auto'
) or (
$data
->{-posx} < 0)) {
$posx
=
int
((
$self
->g_winfo_screenwidth() -
$width
) / 2);
}
else
{
$posx
=
$data
->{-posx};
}
if
((
$data
->{-posy} eq
'auto'
) or (
$data
->{-posy} < 0)) {
$posy
=
int
((
$self
->g_winfo_screenheight() -
$height
) / 2);
}
else
{
$posy
=
$data
->{-posy};
}
# Set image
my
$canvas
=
$data
->{canvas} =
$self
->new_canvas(
-width
=>
$width
,
-height
=>
$height
,
-highlightthickness
=> 0,
);
$canvas
->g_pack();
if
(
$data
->{-image}) {
$canvas
->create_image(
qw(0 0)
,
-anchor
=>
'nw'
,
-image
=>
$data
->{-image});
}
# Hide on click
if
(
$data
->{-hideonclick}) {
Tkx::
bind
(
$canvas
,
'<ButtonPress-1>'
,
sub
{
$self
->hide();
});
}
# Hide on delay
if
(
$data
->{-delay}) {
Tkx::
after
(
$data
->{-delay},
sub
{
$self
->hide();
})
}
# Set geometry
$self
->g_wm_geometry(
"${width}x${height}+${posx}+${posy}"
);
# Show window
if
(
$data
->{-show}) {
$self
->show();
}
}
#----------------------------------------------------------------------------
# Method : show
# Purpose : Show splashscreen toplevel
# Notes :
#----------------------------------------------------------------------------
sub
show {
my
(
$self
) =
@_
;
$self
->g_wm_deiconify();
$self
->g_raise();
$self
->g_focus();
}
#----------------------------------------------------------------------------
# Method : hide
# Purpose : Hide splashscreen
# Notes :
#----------------------------------------------------------------------------
sub
hide {
my
(
$self
) =
@_
;
$self
->g_wm_withdraw();
}
#----------------------------------------------------------------------------
# Method : canvas
# Purpose : Return canvas
# Notes :
#----------------------------------------------------------------------------
sub
canvas {
my
(
$self
) =
@_
;
return
$self
->_data->{canvas};
}
1;
__END__
=pod
=head1 NAME
Tkx::SplashScreen - splashscreen megawidget for Tkx.
=head1 VERSION
This documentation referers to Tkx::SplashScreen version 0.16
=head1 SYNOPSIS
use Tkx;
use Tkx::SplashScreen;
Tkx::package_require('img::png');
my $mw = Tkx::widget->new('.');
$mw->g_wm_withdraw();
my $sr = $mw->new_tkx_SplashScreen(
-image => Tkx::image_create_photo(-file => './image.png'),
-width => 'auto',
-height => 'auto',
-show => 1,
-topmost => 1,
);
my $cv = $sr->canvas();
$cv->create_text(qw(10 10), -text => 'Loading...', -anchor => 'w');
# Do some stuff.
# Destroy splash screen and show main window.
Tkx::after(5000 => sub {
$sr->g_destroy();
$mw->g_wm_deiconify();
});
=head1 DESCRIPTION
Tkx::SplashScreen is a megawidget that describes an image that
appears while application is loading.
=head1 OPTIONS
The options bellow are passed through the constructor of megawidget.
=head2 C<-image =E<gt> I<image>>
Background image.
=head2 C<-width =E<gt> I<width>>
Width. Default is 400.
=head2 C<-height =E<gt> I<height>>
Height. Default is 300.
=head2 C<-posx =E<gt> I<x>>
Position X of top left corner.
By default window fits center the screen.
=head2 C<-posy =E<gt> I<y>>
Position Y of top left corner.
By default window fits center the screen.
=head2 C<-delay =E<gt> I<ms>>
Delay in milliseconds after window will be hidden.
=head2 C<-alpha =E<gt> I<level>>
Alpha transparency level of the window (only win32).
Default is 1.0
=head2 C<-override =E<gt> I<overrideredirect>>
Override redirect flag. Enable by default.
=head2 C<-show =E<gt> I<show>>
Show splash screen after construction.
=head2 C<-hideonclick =E<gt> I<hideonclick>>
Hide splash screen on mouse click
=head1 METHODS
Tkx::SplashScreen methods.
=head2 C<new>
Constructor.
=head2 C<configure>
Configure widget properties after constructing.
=head2 C<show>
Show splash screen.
=head2 C<hide>
Hide splash screen.
=head2 C<canvas>
Returns canvas for the splash screen.
=head1 BUGS AND LIMITATIONS
None known at this time.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Tkx::SplashScreen
=head1 AUTHOR
Alexander Nusov <alexander.nusov+cpan <at> gmail.com>
=head1 COPYRIGHTS AND LICENSE
Copyright (C) 2009-2010 Alexander Nusov
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut