#!/usr/bin/env perl
my
$MW
= MainWindow->new;
my
$f
=
$MW
->Frame(
-bg
=>
'blue'
);
$f
->
pack
;
my
$ce
=
$f
->Button(
-text
=>
'Color Editor'
);
$ce
->
pack
;
my
$qu
=
$f
->Button(
-text
=>
'Quit'
,
-command
=> \
&exit
);
$qu
->
pack
;
my
$f2
=
$f
->Frame;
$f2
->
pack
;
my
$f2b1
=
$f2
->Button(
-text
=>
'f2b1'
);
$f2b1
->
pack
(
-side
=>
'left'
);
my
$f2b2
=
$f2
->Button(
-text
=>
'f2b1'
);
$f2b2
->
pack
(
-side
=>
'left'
);
my
$cref
=
$MW
->ColorEditor(
-title
=>
'Test CE'
,
-cursor
=> [
'@'
. Tk->findINC(
'demos/images/cursor.xbm'
),
Tk->findINC(
'demos/images/cursor.mask'
),
'red'
,
'green'
],
);
$ce
->configure(
-command
=> [
$cref
=>
'Show'
]);
sub
my_special_configurator {
my
(
$objref
,
$type
,
$color
) =
@_
;
print
"\nColorEditor object reference : $objref\n"
;
print
"Color attribute : $type\n"
;
print
"New color : $color\n"
;
print
"display_status : "
,
$objref
->cget(
'-display_status'
),
"\n"
;
print
"color_list widget references :\n"
;
print
join
(
"\n"
, @{
$objref
->cget(
'-widgets'
)}),
"\n"
;
}
$cref
->delete_menu_item(3);
$cref
->delete_menu_item(
'disabledForeground'
,
'troughColor'
);
$cref
->add_menu_item(
'SEP'
,
'frog colors'
);
$cref
->configure(
-display_status
=> 1,
-widgets
=> [
$ce
,
$qu
,
$f2b2
],
);
my
$e
=
$MW
->ErrorDialog;
$e
->Subwidget(
'error_dialog'
)->Subwidget(
'message'
)->configure(
-bg
=>
'red'
);
MainLoop;