use Tk;
use Tk::Radiobutton;
use Tk::Checkbutton;
use Tk::StyledButton;
use Tk::LabEntry;
use Tk::Font;
use strict;
use warnings;
my $style = 'shiny';
my $angle = 0.25;
my $slots = 30;
my $color = '#4D004D00B300';
my $fullcolor = '#4D004D00B300(65535, 0, 0)';
my $textcolor = 'black';
my $fulltextcolor = 'black(0, 0, 0)';
my $disperse = 0.8;
my $shape = 'oval';
my $scrolled = 0;
my $text;
my $image;
my $gd;
my $topbtn = 0;
my $hasgd;
my $hasfontdlg;
my $fontinfo;
eval {
require GD;
require GD::Text;
};
$hasgd = 1 unless $@;
#
# try to set the font directory
#
GD::Text->font_path($ENV{SYSTEMROOT} . '\fonts')
if $hasgd && ($^O eq 'MSWin32');
eval {
require Tk::StyledFontDlg;
};
$hasfontdlg = 1 unless $@;
my @grouped = ([],[],[]);
my $mw = MainWindow->new();
my @demobtns;
my $canframe = $mw->Frame()->pack(-side => 'top', -fill => 'both', -expand => 1);
my $cmdframe = $mw->Frame()->pack(-side => 'bottom');
my $colorbtn = $cmdframe->StyledButton(
-style => 'shiny',
-shape => 'oval',
-text => 'Button Color',
-background => $color,
-command => sub { colorDialog(); } )
->grid(-column => 0, -row => 0);
$cmdframe->Label(-textvariable => \$fullcolor)->grid(-column => 1, -row => 0);
my $textcolorbtn = $cmdframe->StyledButton(
-style => 'shiny',
-shape => 'oval',
-text => 'Text Color',
-background => $textcolor,
-command => sub { textColorDialog(); } )
->grid(-column => 0, -row => 1);
$cmdframe->Label(-textvariable => \$fulltextcolor)->grid(-column => 1, -row => 1);
my $fontbtn = $cmdframe->StyledButton(
-style => 'shiny',
-shape => 'oval',
-text => ' Font ',
-command => sub { setButtonFont(); } )
->grid(-column => 0, -row => 3);
$cmdframe->Label(-textvariable => \$fontinfo)->grid(-column => 1, -row => 3);
$fontbtn->configure(-state => 'disabled')
unless $hasfontdlg;
my $i = 1;
$cmdframe->Label(-text => 'Button style:')->grid(-column => 0, -row => 4);
$cmdframe->Radiobutton(
-text => $_,
-value => $_,
-variable => \$style)
->grid(-column => $i++, -row => 4)
foreach ('flat', 'round', 'shiny', 'gel');
$cmdframe->Label(-text => 'Button shape:')->grid(-column => 0, -row => 5);
$i = 1;
$cmdframe->Radiobutton(
-text => $_,
-value => $_,
-variable => \$shape)
->grid(-column => $i++, -row => 5)
foreach ('rectangle', 'round', 'oval', 'folio', 'bevel');
$i = 1;
$cmdframe->Label(-text => 'Tab Alignment:')->grid(-column => 0, -row => 6);
$cmdframe->Radiobutton(
-text => $_,
-value => $_,
-variable => \$style)
->grid(-column => $i++, -row => 6)
foreach ('ne', 'nw', 'se', 'sw');
$i = 1;
$cmdframe->Radiobutton(
-text => $_,
-value => $_,
-variable => \$style)
->grid(-column => $i++, -row => 7)
foreach ('en', 'es', 'wn', 'ws');
$cmdframe->Label(-text => 'Dispersion:')
->grid(-column => 0, -row => 8, -sticky => 'e');
$cmdframe->Scale(
-orient => 'horizontal',
-digits => 4,
-from => 0.0,
-to => 1.0,
-troughcolor => 'white',
-resolution => 0.01,
-showvalue => 1,
-variable => \$disperse,
-width => 10,
-length => 250)
->grid(-column => 1, -columnspan => 4, -row => 8, -sticky => 'w');
$cmdframe->Label(-text => 'Angle:')->grid(-column => 0, -row => 9, -sticky => 'e');
$cmdframe->Scale(
-orient => 'horizontal',
-digits => 4,
-from => 0.0,
-to => 1.0,
-troughcolor => 'white',
-resolution => 0.01,
-showvalue => 1,
-variable => \$angle,
-width => 10,
-length => 250)
->grid(-column => 1, -columnspan => 4, -row => 9, -sticky => 'w');
my $le = $cmdframe->LabEntry(
-label => 'Button text:',
-labelPack => [ qw/-side left -anchor w/],
-bg => 'white',
-textvariable => \$text,
-font => [ -family => 'arial', -size => 12, -weight => 'bold' ])
->grid(-column => 0, -row => 10, -columnspan => 5);
my $font = $le->cget(-font);
$fontinfo = join('-', $font->actual(-family), $font->actual(-size), $font->actual(-weight), $font->actual(-slant));
$cmdframe->Checkbutton(
-text => 'Add image',
-variable => \$image)
->grid(-column => 0, -row => 11, -columnspan => 2);
my $gdbtn = $cmdframe->Checkbutton(
-text => 'Use GD',
-variable => \$gd)->grid(-column => 2, -row => 11, -columnspan => 2);
$gdbtn->configure(-state => 'disabled') unless $hasgd;
$cmdframe->StyledButton(
-style => 'shiny',
-shape => 'oval',
-text => 'Render',
-command => sub { renderButton(); })
->grid(-column => 0, -row => 12, -columnspan => 2);
$cmdframe->StyledButton(
-style => 'shiny',
-shape => 'oval',
-text => 'Rotate',
-command => sub { rotateButton(); })
->grid(-column => 2, -row => 12, -columnspan => 2);
my $started = 1;
renderButton();
MainLoop();
sub colorDialog {
my $rgb;
$color = $cmdframe->chooseColor(-title => 'Button color', -initialcolor => $color),
$colorbtn->configure(-background => $color, -activebackground => $color),
$rgb = $mw->rgb($color),
$fullcolor = "$color(" . join(', ', @$rgb) . ')'
if $started;
}
sub textColorDialog {
my $rgb;
$textcolor = $cmdframe->chooseColor(-title => 'Button color', -initialcolor => $textcolor),
$textcolorbtn->configure(-background => $textcolor, -activebackground => $textcolor),
$rgb = $mw->rgb($textcolor),
$fulltextcolor = "$textcolor(" . join(', ', @$rgb) . ')'
if $started;
}
sub setButtonFont {
#
# open font dialog, collect data, and update
# display
#
$font = $mw->StyledFontDlg(-style => 'shiny', -shape => 'oval')->Show();
$le->configure(-font => $font);
$fontinfo = join('-', $font->actual(-family), $font->actual(-size), $font->actual(-weight), $font->actual(-slant));
}
sub renderButton {
#print $demobtn, "\n";
# $demobtn->withdraw() if $demobtn;
# $demobtn = undef;
unless ($demobtns[0]) {
$text = "$shape, $style";
$demobtns[$_] = $canframe->StyledButton(
-style => $style,
-shape => $shape,
-angle => $angle,
-dispersion => $disperse,
-background => $color,
-text => $text,
-font => $font)->pack(-side => 'left')
foreach (0..1);
return 1;
}
foreach (0..1) {
$text ?
$demobtns[$_]->configure(
-style => $style,
-shape => $shape,
-angle => $angle,
-dispersion => $disperse,
-background => $color,
-foreground => $textcolor,
-text => $text,
-font => $font) :
$demobtns[$_]->configure(
-style => $style,
-shape => $shape,
-angle => $angle,
-dispersion => $disperse,
-background => $color,
-foreground => $textcolor,
-text => '',
-font => $font);
}
}