=**************************************
= Name: IsDate - PerlTk
= Description:This is an example of usin
= g PerlTk with my IsDate Function. Shows
= how to create GUI's on a Windows OS Syst
= em using Tk.
= By: Randy McCleary
=
=This code is copyrighted and has = limited warranties.Please see http://w
= ww.Planet-Source-Code.com/vb/scripts/Sho
= wCode.asp?txtCodeId=518&lngWId;=6 =for details. =**************************************
#!/usr/bin/perl -w
############################################
## An Example of how to create GUI's
## in perl with the Tk package
############################################
use strict;
use Tk;
use POSIX;
use Time::Local;
############################################
## 1. Create a New Window
## 2. Set the Window Size
## 3. Set the title of the window
############################################
my $main = MainWindow->new;
$main->geometry("359x283+8+8");
$main->title("IsDate() in PerlTk By - Randy McCleary");
############################################
## Now We are creating a Lable
## -anchor = The position of the Text
## inside the Label, options are:
## (n,ne,nw,s,sw,se,e,w) All are
## Directions n = North, s = South
## and so on, get the point?
## -text = The text displayed in the label
## -background = labels background color
## -cursor = Specifies the mouse cursor to
## be used for the widget. The value
## may have any of the forms acceptable
## to Tk_GetCursor
## -font = Font of the text in the label
## -foreground = This is the font color
############################################
my $label = $main->Label(
-anchor => "w",
-text => "Input a Date to Validate:",
-background => "#D4D0C8",
-cursor => "",
-font => "Tahoma 10 bold",
-foreground => "#000077"
)->pack;
############################################
## Now We are going to specify where to
## place the label we just created on to
## the form, so we set the width and height
## of the label and give x/y coordinates
## of where to place it at.
############################################
$label->place(
-width => 160,
-height => 16,
-x => 8,
-y => 8
);
############################################
## Now we are going to create and Entry box
## aka. TextBox or InputBox. We will use
## this to grab the input to check if the
## inputted date string is in valid format.
############################################
my $txtInput = $main->Entry(
-borderwidth => 1,
-cursor => "",
-font => "Tahoma 8 normal",
-foreground => "#000000",
-relief => "sunken"
)->pack;
$txtInput->place(
-width => 152,
-height => 24,
-x => 8,
-y => 32
);
############################################
## Next We create a Button aka CommandButton
## this is what we will use to call the
## IsDate Sub when this button is clicked on
## -command = This calls the sub.
## sub{sub_name_here(input1, input2)}
## and so on, you can have more than 1
## input or have no inputs.
## Without arguments:
## -command => \&subname;
## -command => sub { ... }
## -command => 'methodname'
## or with arguments:
## -command => [ \&subname; ?, args ...? ]
## -command => [ sub { ... } ?, args...? ]
## -command => [ 'methodname' ?, args...?]
############################################
my $cmdIsDate = $main->Button(
-activebackground => "#FFFCBF",
-activeforeground => "#E30229",
-background => "#FFFFFF",
-borderwidth => 1,
-text => "Validate Date",
-command => sub{IsDate($txtInput)},
-cursor => "",
-font => "Tahoma 8 bold",
-foreground => "#140F7B",
-relief => "solid"
)->pack;
############################################
## Place the button on the form
############################################
$cmdIsDate->place(
-width => 104,
-height => 24,
-x => 176,
-y => 32
);
############################################
## Now we create a Label just to display
## the Text "The Date is:"
############################################
my $lblDisplay = $main->Label(
-anchor => "w",
-text => "The Date is: ",
-background => "#D4D0C8",
-cursor => "",
-font => "Tahoma 8 bold"
);
$lblDisplay->place(
-width => 96,
-height => 24,
-x => 8,
-y => 80
);
############################################
## Now we create a Label to store the value
## thats returned from the sub IsDate
## this will display True/False.
############################################
my $lblDate = $main->Label(
-anchor => "w",
-borderwidth => 1,
-text => "",
-background => "#FFFFFF",
-cursor => "",
-font => "Tahoma 8 normal",
-relief => "solid",
-highlightbackground => "#000000",
-justify => "right"
)->pack;
$lblDate->place(
-width => 128,
-height => 24,
-x => 120,
-y => 80
);
my $lblHead = $main->Label(
-anchor => "w",
-text => "Valid Formats Below:",
-background => "#D4D0C8",
-cursor => "",
-font => "Tahoma 8 bold"
);
$lblHead->place(
-width => 216,
-height => 24,
-x => 16,
-y => 110
);
############################################
## Creating a Text String to display all
## the valid date formats in a label
############################################
my $strText = ("1. 10/20/2003-mm/dd/yyyy
2. 10-20-2003-mm-dd-yyyy
3. 20/10/2003-dd/mm/yyyy
4. 20-10-2003-dd-mm-yyyy
5. 2003-10-20-yyyy-mm-dd
6. Thursday, June 26, 2003
7. Sat Oct 25 14:23:17 2003");
############################################
## Now we are creating a label to display
## the string variable generated above. This
## will put all the valid date formats in
## the label to display to the user.
############################################
my $lblNotes = $main->Label(
-anchor => "nw",
-borderwidth => 1,
-text => $strText,
-background => "#D4D0C8",
-cursor => "",
-font => "Tahoma 8 normal",
-justify => "left",
-relief => "sunken"
)->pack;
$lblNotes->place(
-width => 312,
-height => 112,
-x => 16,
-y => 136
);
MainLoop;
########################################################
## Now we place all the subs below here. Which we only
## have one sub so it is below. But if we had more than
## one sub, then it could go anywhere just as long as
## its below the MainLoop;
########################################################
sub IsDate {
###########################
## Retrieve the input Data
###########################
my ($Input) = @_;
my $dtmDate = $Input->get;
###########################
my $strDays = "Sunday|Monday|Tuesday|Wednesday|Thursday|Friday|Saturday";
my $strAbbrDays = "Sun|Mon|Tue|Thu|Fri|Sat";
my $strMons = "January|February|March|April|May|June|July|
August|September|October|November|December";
my $strAbbrMons = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
my @arrMonths = ("January","February","March","April","May","June","July",
"August","September","October","November","December");
my @arrAbbrMonths = ("Jan","Feb","Mar","Apr","May","Jun",
"Jul","Aug","Sep","Oct","Nov","Dec");
my @arrDays = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday");
my $strDay = '';
my $intMonth = -1;
my ($sec,$min,$hour,$day,$month,$year,$wday,$mhour) = 0;
my ($DateTime, $WeekDayName, $i, $strTheMonth) = 0;
my $strReturn = '';
### 10/20/2003
if ($dtmDate =~ /^(\d{1,2})(\/|-)(\d{1,2})\2(\d{4})$/) {
if (($1 < 1 || $1 > 12) && ($3 < 1 || $3 > 12)) {
$strReturn = "False";
}
if (($3 < 1 || $3 > 31) && ($3 < 1 || $3 > 31)) {
$strReturn = "False";
}
if ((($1==4 || $1==6 || $1==9 || $1==11) && $3==31) || (($3==4 || $3==6 || $3==9 || $3==11) && $1==31)) {
$strReturn = "False";
}
if ($1 == 2) {
if ($3>29 || ($3==29 && !($4 % 4 == 0 && ($4 % 100 != 0 || $4 % 400 == 0)))) {
$strReturn = "False";
}
}
}
### 2003-10-20
elsif ($dtmDate =~ /^(\d{4})(\-)(\d{1,2})\2(\d{1,2})$/) {
if ($3 < 1 || $3 > 12) {
$strReturn = "False";
}
if ($4 < 1 || $4 > 31) {
$strReturn = "False";
}
if (($3==4 || $3==6 || $3==9 || $3==11) && $4==31) {
$strReturn = "False";
}
if ($3 == 2) {
if ($4>29 || ($4==29 && !($1 % 4 == 0 && ($1 % 100 != 0 || $1 % 400 == 0)))) {
$strReturn = "False";
}
}
}
### Thursday, June 26, 2003
elsif ($dtmDate =~ /^($strDays), ($strMons) (\d{1,2}), (\d{4})$/i) {
### The Input has a valid Date Format, now its time to Validate
### the inputted to date to see is a Valid Date
$strTheMonth = $2;
foreach (@arrMonths) {
if ($_ eq ucfirst(lc($strTheMonth))) {
$intMonth = $i;
last;
}
$i++;
}
if ($intMonth > 11 || $intMonth < 0) {
$strReturn = "False";
}
### If the days in the month for April, June, September, November equals 31
###then the input date is invalid.
if (($intMonth==4 || $intMonth==6 || $intMonth==9 || $intMonth==11) && $3==31) {
$strReturn = "False";
}
### If Leap Year then allow the days in the month of february to be 29, else only
### allow the number of days to be 28.
if ($intMonth == 1) {
if ($3>29 || ($3==29 && !($4 % 4 == 0 && ($4 % 100 != 0 || $4 % 400 == 0)))) {;
$strReturn = "False";
}
}
### Convert the DateTime to Seconds so you can use Perl's localtime function.
### Use Perl's localtime function to get the week day to verify if the date is valid.
$DateTime = timelocal(0,0,0, $3, $intMonth, $4);
($sec,$min,$hour,$day,$month,$year,$wday) = localtime($DateTime);
### Set the WeekDay Name from the $wday(0-6) from localtime.
$WeekDayName = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")[$wday];
### If the Inputted WeekDay name isn't the same as what was returned from Perl's
### localtime function then the input date is invalid.
#$strDay = $1;
my $strDay = ucfirst(lc($1));
if ($strDay ne $WeekDayName) {
$strReturn = "False";
}
}
### Sat Oct 25 14:23:17 2003
elsif ($dtmDate =~ /^($strAbbrDays) ($strAbbrMons) (\d{1,2}) (\d{2}):(\d{2}):(\d{2}) (\d{4})$/i) {
### The Input has a valid Date Format, now its time to Validate
### the inputted to date to see is a Valid Date
### Code to Validate the Date String
$strTheMonth = $2;
foreach (@arrAbbrMonths) {
if ($_ eq ucfirst(lc($strTheMonth))) {
$intMonth = $i;
last;
}
$i++;
}
if ($intMonth > 11 || $intMonth < 0) {
$strReturn = "False";
}
### If the days in the month for April, June, September, November equals 31
###then the input date is invalid.
if (($intMonth==4 || $intMonth==6 || $intMonth==9 || $intMonth==11) && $3==31) {
$strReturn = "False";
}
### If Leap Year then allow the days in the month of february to be 29, else only
### allow the number of days to be 28.
if ($intMonth == 1) {
if ($3>29 || ($3==29 && !($7 % 4 == 0 && ($7 % 100 != 0 || $7 % 400 == 0)))) {
$strReturn = "False";
}
}
if ($4>=24 || $4<0 || $5>=60 || $5<0 || $6>=60 || $6<0) {
$strReturn = "False";
}
### Convert the DateTime to Seconds so you can use Perl's localtime function.
### Use Perl's localtime function to get the week day to verify if the date is valid.
$DateTime = timelocal($6, $5, $4, $3, $intMonth, $7);
($sec,$min,$hour,$day,$month,$year,$wday) = localtime($DateTime);
### Set the WeekDay Name from the $wday(0-6) from localtime.
$WeekDayName = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$wday];
### If the Inputted WeekDay name isn't the same as what was returned from Perl's
### localtime function then the input date is invalid.
#$strDay = $1;
my $strDay = ucfirst(lc($1));
if ($strDay ne $WeekDayName) {
$strReturn = "False";
}
}
else {
$strReturn = "False";
}
######################################
## If the return string is not equal
## to False then the date inputted is
## valid so set it to True
######################################
if ($strReturn ne "False") {
$strReturn = "True";
}
######################################
## Now we are changing the Text in
## lblDate, to show if the Date string
## is valid or not. True/False
######################################
$lblDate->configure(-text => $strReturn);
}
|
