The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

HANJE / Tk-TabbedForm-0.01 / lib / Tk / TabbedForm / CColorItem.pm 

            

              
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
48
49
50
51
52
53
54
55
56
—
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

              
package Tk::TabbedForm::CColorItem;
=head1 NAME
Tk::TabbedForm::CColorItem - ColorEntry widget for Tk::TabbedForm.
=cut
use strict;
use warnings;
use base qw(Tk::Derived Tk::TabbedForm::CTextItem);
Construct Tk::Widget 'CColorItem';
require Tk::ColorEntry;
=head1 SYNOPSIS
 require Tk::TabbedForm::CColorItem;
 my $bool = $window->CColorItem(@options)->pack;
=head1 DESCRIPTION
Inherits L<Tk::TabbedForm::CTextItem>. Provides a ColorEntry field for L<Tk::TabbedForm>
You should never create an instance directly like above. This should
be handled by L<Tk::TabbedForm>.
=head1 B<CONFIG VARIABLES>
All options, except I<-variable>, of L<Tk::Checkbutton> are available.
=cut
sub Populate {
        my ($self,$args) = @_;
        $args->{'-regex'} = '^#(?:[0-9a-fA-F]{3}){1,4}$';
        $self->SUPER::Populate($args);
        $self->ConfigSpecs(
                -background => ['SELF', 'DESCENDANTS'],
                DEFAULT => [$self->Subwidget('Entry')],
        );
}
sub createHandler {
        my ($self, $var) = @_;
        my $e = $self->ColorEntry(
                -variable => $var,
        )->pack(-side => 'left', -padx => 2, -expand => 1, -fill => 'x');
        $self->Advertise(Entry => $e);
}
sub put {
        my ($self, $color) = @_;
        $self->SUPER::put($color);
        $self->Subwidget('Entry')->EntryUpdate;
}
=head1 LICENSE
Same as Perl.
=head1 AUTHOR
Hans Jeuken (hanje at cpan dot org)
=head1 BUGS
Unknown. If you find any, please contact the author.
=head1 SEE ALSO
=over 4
=item L<Tk::ColorEntry>
=item L<Tk::TabbedForm>
=item L<Tk::TabbedForm::CTextItem>
=back
=cut
1;
__END__