File Coverage

blib/lib/Wx/DemoModules/wxFontDialog.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/wxFontDialog.pm
3             ## Purpose: wxPerl demo helper for Wx::FontDialog
4             ## Author: Mattia Barbon
5             ## Modified by:
6             ## Created: 11/02/2001
7             ## RCS-ID: $Id: wxFontDialog.pm 2189 2007-08-21 18:15:31Z mbarbon $
8             ## Copyright: (c) 2001, 2003, 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::wxFontDialog;
14              
15 1     1   1325 use strict;
  1         3  
  1         35  
16 1     1   4 use base qw(Wx::DemoModules::lib::BaseModule Class::Accessor::Fast);
  1         17  
  1         137  
17              
18             use Wx qw(:id);
19              
20             sub commands {
21             my( $self ) = @_;
22              
23             return ( { label => 'Font dialog',
24             action => \&font_dialog,
25             },
26             );
27             }
28              
29             sub font_dialog {
30             my( $this ) = @_;
31             my $dialog = Wx::FontDialog->new( $this, Wx::FontData->new );
32              
33             if( $dialog->ShowModal == wxID_CANCEL ) {
34             Wx::LogMessage( "User cancelled the dialog" );
35             } else {
36             my $data = $dialog->GetFontData;
37             my $font = $data->GetChosenFont;
38              
39             if( $font ) {
40             Wx::LogMessage( "Font: %s", $font->GetFaceName );
41             Wx::LogMessage( "Native font info: %s",
42             $data->GetChosenFont->GetNativeFontInfo->ToString );
43             }
44              
45             my $colour = $data->GetColour;
46              
47             if( $colour->Ok ) {
48             Wx::LogMessage( "Colour: (%d, %d, %d)",
49             $colour->Red, $colour->Green, $colour->Blue );
50             } else {
51             Wx::LogMessage( 'No colour' );
52             }
53             }
54              
55             $dialog->Destroy;
56             }
57              
58             sub add_to_tags { qw(dialogs) }
59             sub title { 'wxFontDialog' }
60              
61             1;