1 #############################################################################
2 ## Name: ext/pperl/textval/TextValidator.pm
3 ## Purpose: Wx::Perl::TextValidator, a perl-ish wxTextValidator
4 ## Author: Johan Vromans, Mattia Barbon
7 ## RCS-ID: $Id: TextValidator.pm 2057 2007-06-18 23:03:00Z mbarbon $
8 ## Copyright: (c) 2005 Johan Vromans, Mattia Barbon
9 ## Licence: This program is free software; you can redistribute itand/or
10 ## modify it under the same terms as Perl itself
11 #############################################################################
13 package Wx::Perl::TextValidator;
17 Wx::Perl::TextValidator - Perl replacement for wxTextValidator
22 my $validator1 = Wx::Perl::TextValidator->new( '\d', \$storage );
23 my $validator2 = Wx::Perl::TextValidator->new( '[abcdef]' );
24 my $validator3 = Wx::Perl::TextValidator->new( qr/[a-zA-Z]/ );
26 my $textctrl = Wx::TextCtrl->new( $parent, -1, "", $pos, $size, $style,
31 A C<Wx::Validator> subclass that allows filtering user input to
36 my $validator1 = Wx::Perl::TextValidator->new( $regexp, \$storage );
37 my $validator2 = Wx::Perl::TextValidator->new( $regexp );
39 Constructs a new C<Wx::Perl::Validator>. The first argument must be
40 a regular expression matching a single-character string and is used
41 to validate the field contents and user input. The second argument,
42 if present, is used in TransferDataToWindow/TransferDataToWindow as
43 the source/destination for the fields contents.
45 The first argument can be a string as well as a reqular expression
46 object created using C<qr//>.
51 use Wx qw(:keycode wxOK wxICON_EXCLAMATION);
52 use Wx::Event qw(EVT_CHAR);
53 use Wx::Locale qw(:default);
55 use base qw(Wx::PlValidator);
57 our $VERSION = '0.01';
60 my( $class, $validate, $data ) = @_;
61 my $self = $class->SUPER::new;
63 $self->{validate} = ref $validate ? $validate : qr/^$validate$/;
64 $self->{data} = $data;
66 EVT_CHAR($self, \&OnKbdInput);
72 my ($self, $event) = @_;
73 my $c = $event->GetKeyCode;
75 if( $c < WXK_SPACE || # skip control characters
78 $event->HasModifiers # allow Ctrl-C and such
81 } elsif( pack( "C", $c ) =~ $self->{validate} ) {
91 return ref( $self )->new( $self->{validate}, $self->{data} );
95 my( $self, $window ) = @_;
96 my $value = $self->GetWindow->GetValue;
98 my $ko = grep { !/$self->{validate}/ }
102 Wx::MessageBox( sprintf( gettext( "'%s' is invalid" ), $value ),
103 gettext( "Validation conflict" ),
104 wxOK | wxICON_EXCLAMATION, $window );
110 sub TransferToWindow {
113 if( $self->{data} ) {
114 $self->GetWindow->SetValue( ${$self->{data}} );
120 sub TransferFromWindow {
123 if( $self->{data} ) {
124 ${$self->{data}} = $self->GetWindow->GetValue;