$VERSION
=
'4.000'
;
Construct Tk::Widget
'ColorDialog'
;
sub
Accept
{
my
$cw
=
shift
;
$cw
->withdraw;
$cw
->{
'done'
} = 1;
}
sub
Cancel
{
my
$cw
=
shift
;
$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 });
$cw
->waitVariable(\
$cw
->{
'done'
});
if
(Tk::Exists(
$cw
))
{
$cw
->withdraw;
$cw
->cget(
'-color'
);
}
else
{
undef
;
}
}
1;