Quick Search for:  in language:    
example,using,PerlTk,with,IsDate,Function,Sho
   Code/Articles » |  Newest/Best » |  Community » |  Jobs » |  Other » |  Goto » | 
CategoriesSearch Newest CodeCoding ContestCode of the DayAsk A ProJobsUpload
Perl Stats

 Code: 74,273. lines
 Jobs: 25. postings

 How to support the site

 
Sponsored by:

 
You are in:
 
Login





Latest Code Ticker for Perl.
Click here to see a screenshot of this code!Mailing List v2.0
By Aaron L. Anderson on 1/7

(Screen Shot)

ShowIMG
By Jeff Mills on 1/5


Simple Perl Ping
By John Hass on 12/29


Very basic login script template with cookies
By Aaron L. Anderson on 12/29


Click here to put this ticker on your site!


Add this ticker to your desktop!


Daily Code Email
To join the 'Code of the Day' Mailing List click here!

Affiliate Sites



 
 
   

IsDate - PerlTk

Print
Email
 
VB icon
Submitted on: 8/10/2003 11:59:53 PM
By: Randy McCleary 
Level: Intermediate
User Rating: By 7 Users
Compatibility:5.0 (all versions), Active Perl specific

Users have accessed this code 1857 times.
 
(About the author)
 
     This is an example of using PerlTk with my IsDate Function. Shows how to create GUI's on a Windows OS System using Tk.

 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
 
Terms of Agreement:   
By using this code, you agree to the following terms...   
1) You may use this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.   
2) You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
3) You may link to this code from another website, but ONLY if it is not wrapped in a frame. 
4) You will abide by any additional copyright restrictions which the author may have placed in the code or code's description.

    =**************************************
    = 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);
    }
    	


Other 28 submission(s) by this author

 

 
Report Bad Submission
Use this form to notify us if this entry should be deleted (i.e contains no code, is a virus, etc.).
Reason:
 
Your Vote!

What do you think of this code(in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor See Voting Log
 
Other User Comments
9/15/2003 12:20:17 PM:ICode
Nice, thanks for the code.  Perl is 
becoming more and more interesting 
every day.
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
Add Your Feedback!
Note:Not only will your feedback be posted, but an email will be sent to the code's author in your name.

NOTICE: The author of this code has been kind enough to share it with you.  If you have a criticism, please state it politely or it will be deleted.

For feedback not related to this particular code, please click here.
 
Name:
Comment:

 

Categories | Articles and Tutorials | Advanced Search | Recommended Reading | Upload | Newest Code | Code of the Month | Code of the Day | All Time Hall of Fame | Coding Contest | Search for a job | Post a Job | Ask a Pro Discussion Forum | Live Chat | Feedback | Customize | Perl Home | Site Home | Other Sites | About the Site | Feedback | Link to the Site | Awards | Advertising | Privacy

Copyright© 1997 by Exhedra Solutions, Inc. All Rights Reserved.  By using this site you agree to its Terms and Conditions.  Planet Source Code (tm) and the phrase "Dream It. Code It" (tm) are trademarks of Exhedra Solutions, Inc.