Have you considered using Tk::Month?

There's a simple example of how to use it here.

Even if you decide to go a similar (or different) route, I'd recommend trying it out, as it might give you some good ideas.

You will probably want to play around with printformat, though.  The value used in the node I referred to above doesn't send the day of the month to the anonymous subroutine.

Thanks liverpole,

I had seen that only a few minutes before I posted. Interestingly it adopts the method I was proposing - using a button for each element. But it does work and I think a modified version of it will have a place in my application. I have played with some ideas for using a similar approach to my "week at a view" page and I think I can make it look respectable.

jdtoronto

Hi, How we get subroutine working, e.g. accept values for %a and %e when we press calendar button Insted anonymous subroutine I was using named subrutine, but not working Could someone help?

The %e and %a are just formatting strings. Read perldoc Tk::Month to see how to change it. To get rid of the anonymous sub, it's simple, try this. I showed how to see what is passed to the sub. If this dosn't answer your question, be more specific in what you need to do.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Month;

my $mw = MainWindow->new();

my $month = "November";
my $year = "2006";
my $m = $mw->Month(
    -printformat   => '%a %e',
    -includeall    => 0,
    -month         => $month,
    -year          => $year,

    -command       => \&mysub
);
$m->pack;

MainLoop;

sub mysub {
        print scalar @_,"\n";
        print $_[0],"\n";
        print $_[1],"\n";
        print @{$_[1]},"\n";
       
        my ($ym, $wd) = @_;
        my ($month, $year) = split( /\s+/ , $ym );
        my ($wday, $date)  = split( /\s+/ , $wd->[0] );
        print "$wday, $month $date $year\n";
    }
[download]

---

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Line up Calendar

Tk::MiniCalendar

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::ChooseDate;

#sets date thru the textvariable
my $date = '2006/6/6';

my $mw = new MainWindow;
$mw->geometry('200x50');

$mw->fontCreate('big',
   -family=>'courier',
     -weight=>'bold',
       -size=>int(-18*18/14));

my $cd = $mw->ChooseDate(
      -language =>'Italian',
      -font =>'big',         # the label font
      -bg=>'lightsteelblue',  #the label bg
      -textvariable=>\$date,
      -arrowcolor => 'black',
      -arrowactivecolor=>'yellow',
      -datecolor=> 'blue',
      -dateformat => 1,
      -orthodox => 0, 
      -daysofweekcolor=>'lightgreen',
      -highlightcolor=> 'pink', 
      -linecolor=> 'green',
      -yearcolor=> 'black',
      -command=>sub{print "$date\n"},
)->pack(-fill=>'x', -expand=>1);

my $cdcan = $cd->Subwidget('canvas');
$cdcan->configure(-bg=>'black');  # bg of weekdays bar 

my $cdtop = $cd->Subwidget('toplevel');
$cdtop->configure(-bg=>'black');  # outline of popup 

# sets the date thru set
$cd->set( y=>2005, m=>5, d=>5 );

MainLoop;
[download]

#!/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;

$year ||= '2006';
$month ||= '07';

# 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 win
+dow title
for ( my $row = 0 ; $row < 7 ; $row++ ) {                # create cale
+ndar rows
    for ( my $col = 0 ; $col < 7 ; $col++ ) {    # create calendar col
+umns
        $b = $m->Button(
            -width            => 2,              # Create Button
            -activeforeground => 'white',        # format the foregrou
+nd
            -activebackground => 'blue'
        );                                       # also the background
        $b->grid( -row => $row, -column => $col ); # put this in the r
+ight place
        if ( $row eq 0 ) {                         # if first row,
            $b->configure(
                -text  => $dayArray[$col],         # disable the butto
+n
                -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 i
+s 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 an
+d month)
    my $text = $w->cget( -text );                   # get the text on 
+the button
    print "Date Selected: $text\t$year\t$month\n";  # display informat
+ion
}
[download]

Thanks for the examples. Something I'm missing in the ChooseDate example is how you are supposed to access the selected value. I can see that as values are selected they are printed on the console screen. But how do you use

$cd->get();
[download]

to return an answer? That is, if the code sample had been part of a subroutine, how would the calling portion receive the $cd->get(); output from using ChooseDate?

There are a couple of obvious ways. First the date is stored in a textvariable, so all you have to do is read $date. Second, if you read "perldoc Tk::ChooseDate", there is the get method. Example->
Read more... (2 kB)

---

I'm not really a human, but I play one on earth. Cogito ergo sum a bum