42 lines
990 B
Perl
42 lines
990 B
Perl
|
#!/usr/bin/perl -w
|
||
|
|
|
||
|
|
use Tk;
|
||
|
|
|
||
|
|
$Tk::strictMotif = 1;
|
||
|
|
|
||
|
|
$main = MainWindow->new();
|
||
|
|
|
||
|
|
$button1 = $main->Button(-text => "Exit",
|
||
|
|
-command => \&exit_button,
|
||
|
|
-foreground => "orangered" );
|
||
|
|
|
||
|
|
$button1->pack();
|
||
|
|
|
||
|
|
$button1->configure(-background => "white" );
|
||
|
|
|
||
|
|
$button2 = $main->Button(-text => "Choose Color",
|
||
|
|
-command => \&change_color,
|
||
|
|
-foreground => "black",
|
||
|
|
-background => "steelblue");
|
||
|
|
|
||
|
|
$button2->pack();
|
||
|
|
|
||
|
|
MainLoop();
|
||
|
|
|
||
|
|
sub exit_button {
|
||
|
|
print "You pushed the button!\n";
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub change_color {
|
||
|
|
my($color) = $button2->chooseColor(-initialcolor => "maroon" );
|
||
|
|
|
||
|
|
if ($color ne "") {
|
||
|
|
print "New color is $color\n";
|
||
|
|
|
||
|
|
$button2->configure(-background => $color,
|
||
|
|
-foreground => "white",
|
||
|
|
-font => "-*-times-bold-r-normal-20-140-*");
|
||
|
|
}
|
||
|
|
}
|