File Coverage

blib/lib/Wx/DemoModules/wxGauge.pm
Criterion Covered Total %
statement 6 6 100.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 8 8 100.0


line stmt bran cond sub pod time code
1             #############################################################################
2             ## Name: lib/Wx/DemoModules/wxGauge.pm
3             ## Purpose: wxPerl demo helper for Wx::Gauge
4             ## Author: Mattia Barbon
5             ## Modified by:
6             ## Created: 13/08/2006
7             ## RCS-ID: $Id: wxGauge.pm 2189 2007-08-21 18:15:31Z mbarbon $
8             ## Copyright: (c) 2000, 2003, 2005-2006 Mattia Barbon
9             ## Licence: This program is free software; you can redistribute it and/or
10             ## modify it under the same terms as Perl itself
11             #############################################################################
12              
13             package Wx::DemoModules::wxGauge;
14              
15 1     1   1262 use strict;
  1         2  
  1         29  
16 1     1   5 use base qw(Wx::DemoModules::lib::BaseModule Class::Accessor::Fast);
  1         1  
  1         63  
17              
18             use Wx qw(:gauge :font wxNOT_FOUND);
19             use Wx::Event qw();
20              
21             __PACKAGE__->mk_accessors( qw(gauge timer) );
22              
23             sub create_control {
24             my( $self ) = @_;
25              
26             my $size = [ ( $self->style & wxGA_HORIZONTAL ) ? 200 : -1,
27             ( $self->style & wxGA_VERTICAL ) ? 200 : -1 ];
28             my $gauge = Wx::Gauge->new
29             ( $self, -1, 200, [-1, -1], $size, $self->style );
30             $self->gauge( $gauge );
31             }
32              
33             sub styles {
34             my( $self ) = @_;
35              
36             return ( [ wxGA_HORIZONTAL, 'Horizontal' ],
37             [ wxGA_VERTICAL, 'Vertical' ],
38             [ wxGA_SMOOTH, 'Smooth' ],
39             );
40             }
41              
42             sub commands {
43             my( $self ) = @_;
44              
45             return ( { with_value => 1,
46             label => 'Set Value',
47             action => sub { $self->gauge->SetValue( $_[0] ) },
48             },
49             { with_value => 1,
50             label => 'Set Range',
51             action => sub { $self->gauge->SetRange( $_[0] ) },
52             },
53             );
54             }
55              
56             sub add_to_tags { qw(controls) }
57             sub title { 'wxGauge' }
58              
59             1;