Look for the Tk-ChooseDate module on CPAN.
If you
want to do it the hard way, here is some old code, written
by someone else, (but modified by me to run on newer Tk)
#!/usr/bin/perl
#
# Copyright 2000 Philip Yuson
# Distributed as per the Perl copyright agreement.
#
# This script was written to illustrate Perl/Tk statements.
# it was written with Windows in mind as if this were written for
# Linux or Unix, I would have used the 'cal' command and the routines
# would be a lot simpler.
#
#
use strict;
use Tk; # of course you need this
use Date::Calc; # you need this to calculate your date
# Parms entered are year and month
my ( $year, $month ) = @ARGV;
# set the maximum number of days for each month
my @maxdays = ( 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
#if leap year, change the max days for Feb
$maxdays[2] = 29 if ( $year % 4 == 0 );
#if leap century, change the max days for Feb
$maxdays[2] = 29 if ( $year % 400 == 0 );
# Set $a to get the day of the week
my $a = Date::Calc::Date_to_Text( $year, $month, 01 );
my @dateText = split( " ", $a ); # split on spaces
my @Literal = split( "-", $dateText[1] ); # split on '-'
$_ = $dateText[0]; # set to day of week
my @dayArray = ( 'Su', 'Mo', 'Tu', 'We', 'Th', 'Fr', 'Sa' ); # Set the
day array
#set the day hash
my %days = (
"Sun" => 0,
"Mon" => 1,
"Tue" => 2,
"Wed" => 3,
"Thu" => 4,
"Fri" => 5,
"Sat" => 6
);
my $day = $days{$_}; # get the day number
my $on;
my $ndx = 0; # initialize day number
my $m = new MainWindow; # start a new window
$m->configure( -title => "$Literal[1] $Literal[2]" ); # set the
window title
for ( my $row = 0 ; $row < 7 ; $row++ ) { # create
calendar rows
for ( my $col = 0 ; $col < 7 ; $col++ ) { # create calendar
columns
$b = $m->Button(
-width => 2, # Create Button
-activeforeground => 'white', # format the foreground
-activebackground => 'blue'
); # also the background
$b->grid( -row => $row, -column => $col ); # put this in the
right place
if ( $row eq 0 ) { # if first row,
$b->configure(
-text => $dayArray[$col], # disable the button
-state => 'disabled'
);
}
else {
if ( $col eq $day && $row eq 1 ) {
$on = 1;
$ndx = 1;
} # Turn on switch if start of day
if ( int($ndx) > int( $maxdays[$month] ) ) {
$on = 0;
} # Turn off switch if all days are displayed
if ($on) {
$b->configure( -text => $ndx++ ); # put the day on
the button
# and add one to the day
$b->bind(
"<ButtonPress>", # If the button is
presssed
[ &DateSelected, $year, $month ]
); # execute the Date Selected subroutine
}
else {
$b->configure( -state => 'disabled' )
; # if switch if off, disable button
}
}
if ( $col eq 0 ) { #if first column, this is Sunday
$b->configure(
-fg => 'red', # configure button
-activeforeground => 'white',
-activebackground => 'red'
);
}
}
if ( int($ndx) > int( $maxdays[$month] ) ) {
last;
} # if all days displayed. exit
}
MainLoop; #Loop
sub DateSelected { # execute when button is pressed
my ( $w, $year, $month ) = @_; # get the parms (widget, year and
month)
my $text = $w->cget( -text ); # get the text on
the button
print "Date Selected: $textt$yeart$monthn"; # display
information
}
__END__
--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html