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
|
package Tk::ColorDialog;
require Tk::Toplevel;
use base qw(Tk::Toplevel);
use vars qw($VERSION);
$VERSION = '4.014';
Construct Tk::Widget 'ColorDialog';
sub Accept
{
my $cw = shift;
$cw->withdraw;
$cw->{'done'} = 1;
}
sub Cancel
{
my $cw = shift;
# $cw->configure(-color => undef);
$cw->configure(-color => 'cancel');
$cw->Accept;
}
sub Populate
{
my ($cw,$args) = @_;
$cw->SUPER::Populate($args);
$cw->protocol('WM_DELETE_WINDOW' => [ 'Cancel' => $cw ]);
$cw->transient($cw->Parent->toplevel);
$cw->withdraw;
my $sel = $cw->ColorSelect;
my $accept = $cw->Button(-text => 'Accept', -command => ['Accept', $cw]);
my $cancel = $cw->Button(-text => 'Cancel', -command => ['Cancel', $cw]);
Tk::grid($sel);
Tk::grid($accept,$cancel);
$cw->ConfigSpecs(DEFAULT => [$sel]);
}
sub Show
{
my $cw = shift;
$cw->configure(@_) if @_;
$cw->Popup();
$cw->OnDestroy(sub { $cw->{'done'} = 0 }); # auto-cancel
$cw->waitVariable(\$cw->{'done'});
if (Tk::Exists($cw))
{
$cw->withdraw;
$cw->cget('-color');
}
else
{
undef;
}
}
1;
|
