Richard Suchenwirth - Here's a popup toplevel that displays a given month and allows to pick a date (or cancel):
Nice. A couple of comments (that I might just implement myself when/if I get the time):
CLN, 2001-06-22: Yes, but I thought 8.4 was going to have i18n date support in clock so either mc March or clock format with % for the month name should work. No?
KBK, 27 June 2001: Alas, I've run out of time for 8.4. Internationalizing clock is a bigger job than it looks at first. I'll try to get it done over the summer.
CLN, 2001-06-22: Yes, a different color. I'm not sure how to choose one. ''LV, 2001-Jun-22: Why not choose something Tk-ish, but use the option database so that it could be overridden.
Sorry to whine. It really does look nice but I've thought about this a lot and have strong opinions. -- CLN
Most of this wish list has now been fulfilled in An i15d date chooser
Feel free to add in your changes - that's one of the nice things about the wiki. In particular, if you are going to add in the month names, perhaps you will add them in a way that permits one to configure the language used to convey the months? Configuration is what I will probably be thinking about (after I think about what it will take to build a parallel widget for selecting time.
Unfortunately, my coding skills are such that one should not hold their breath waiting on me to write the time widget.
namespace eval date { option add *Button.padX 0 option add *Button.padY 0 proc choose {} { variable month; variable year; variable date variable canvas; variable res variable day set year [clock format [clock seconds] -format "%Y"] scan [clock format [clock seconds] -format "%m"] %d month scan [clock format [clock seconds] -format "%d"] %d day toplevel .chooseDate -bg white wm title .chooseDate "Choose Date:" frame .chooseDate.1 entry .chooseDate.1.1 -textvar date::month -width 3 -just center button .chooseDate.1.2 -text ^ -command {date::adjust 1 0} button .chooseDate.1.3 -text v -command {date::adjust -1 0} entry .chooseDate.1.4 -textvar date::year -width 4 -just center button .chooseDate.1.5 -text ^ -command {date::adjust 0 1} button .chooseDate.1.6 -text v -command {date::adjust 0 -1} eval pack [winfo children .chooseDate.1] -side left \ -fill both set canvas [canvas .chooseDate.2 -width 160 -height 160 -bg white] frame .chooseDate.3 entry .chooseDate.3.1 -textvar date::date -width 10 button .chooseDate.3.2 -text OK -command {set date::res $date::date} button .chooseDate.3.3 -text Cancel -command {set date::res {}} eval pack [winfo children .chooseDate.3] -side left eval pack [winfo children .chooseDate] display vwait ::date::res destroy .chooseDate set res } proc adjust {dmonth dyear} { variable month; variable year; variable day set year [expr {$year+$dyear}] set month [expr {$month+$dmonth}] if {$month>12} {set month 1; incr year} if {$month<1} {set month 12; incr year -1} if {[numberofdays $month $year]<$day} { set day [numberofdays $month $year] } display } proc display {} { variable month; variable year variable date; variable day variable canvas $canvas delete all set x0 20; set x $x0; set y 20 set dx 20; set dy 20 set xmax [expr {$x0+$dx*6}] foreach i {S M T W T F S} { $canvas create text $x $y -text $i -fill blue incr x $dx } scan [clock format [clock scan $month/1/$year] \ -format %w] %d weekday set x [expr {$x0+$weekday*$dx}] incr y $dy set nmax [numberofdays $month $year] for {set d 1} {$d<=$nmax} {incr d} { set id [$canvas create text $x $y -text $d -tag day] if {$d==$day} {$canvas itemconfig $id -fill red} incr x $dx if {$x>$xmax} {set x $x0; incr y $dy} } $canvas bind day <1> { set item [%W find withtag current] set date::day [%W itemcget $item -text] set date::date "$date::month/$date::day/$date::year" %W itemconfig day -fill black %W itemconfig $item -fill red } set date "$month/$day/$year" } proc numberofdays {month year} { if {$month==12} {set month 1; incr year} clock format [clock scan "[incr month]/1/$year 1 day ago"] \ -format %d } } ;# end namespace date #------ test and demo code (terminate by closing the main window) while 1 { set date [date::choose] puts $date }
2001-06-22 RS: stepping through months does not check for day validity, so you may get dates like 2/31/1999. Fixed in proc adjust.
2003-03-06 David Bigelow: Added the ability to cahnge fonts, highlight weights, and included rectangles around each weekday and date within the canvas - so it looks more like a calendar.
BTW - Nice job on this Tcl Code - it is impressive!
Dave
namespace eval date { set defaultFont {Arial 10 normal} option add *Button.padX 0 option add *Button.padY 0 option add *Button.font $defaultFont option add *Entry.font $defaultFont variable canvasFont $defaultFont variable canvasHighlight {Arial 11 bold} variable canvasHeader {Arial 14 bold} proc choose {} { variable month; variable year; variable date variable canvas; variable res variable day set year [clock format [clock seconds] -format "%Y"] scan [clock format [clock seconds] -format "%m"] %d month scan [clock format [clock seconds] -format "%d"] %d day toplevel .chooseDate -bg white wm title .chooseDate "Choose Date:" frame .chooseDate.1 entry .chooseDate.1.1 -textvar date::month -width 3 -just center button .chooseDate.1.2 -text ^ -command {date::adjust 1 0} button .chooseDate.1.3 -text v -command {date::adjust -1 0} entry .chooseDate.1.4 -textvar date::year -width 4 -just center button .chooseDate.1.5 -text ^ -command {date::adjust 0 1} button .chooseDate.1.6 -text v -command {date::adjust 0 -1} eval pack [winfo children .chooseDate.1] -side left \ -fill both set canvas [canvas .chooseDate.2 -width 160 -height 160 -bg white] frame .chooseDate.3 entry .chooseDate.3.1 -textvar date::date -width 10 button .chooseDate.3.2 -text OK -command {set date::res $date::date} button .chooseDate.3.3 -text Cancel -command {set date::res {}} eval pack [winfo children .chooseDate.3] -side left eval pack [winfo children .chooseDate] display vwait ::date::res destroy .chooseDate set res } proc adjust {dmonth dyear} { variable month; variable year; variable day set year [expr {$year+$dyear}] set month [expr {$month+$dmonth}] if {$month>12} {set month 1; incr year} if {$month<1} {set month 12; incr year -1} if {[numberofdays $month $year]<$day} { set day [numberofdays $month $year] } display } proc display {} { variable month; variable year variable date; variable day variable canvas $canvas delete all set x0 20; set x $x0; set y 20 set dx 20; set dy 20 set xmax [expr {$x0+$dx*6}] foreach i {S M T W T F S} { $canvas create text $x $y -text $i -fill blue -font $date::canvasHeader $canvas create rectangle [expr $x-10] [expr $y-10] [expr $x+10] [expr $dy+10] -fill grey90 -tags boxes incr x $dx } scan [clock format [clock scan $month/1/$year] \ -format %w] %d weekday set x [expr {$x0+$weekday*$dx}] incr y $dy set nmax [numberofdays $month $year] for {set d 1} {$d<=$nmax} {incr d} { set id [$canvas create text $x $y -text $d -font $date::canvasFont -tag day] $canvas create rectangle [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] -fill grey90 -tags boxes if {$d==$day} {$canvas itemconfig $id -fill red -font $date::canvasHighlight} incr x $dx if {$x>$xmax} {set x $x0; incr y $dy} } $canvas lower boxes $canvas bind day <1> { set item [%W find withtag current] set date::day [%W itemcget $item -text] set date::date "$date::month/$date::day/$date::year" %W itemconfig day -fill black -font $date::canvasFont %W itemconfig $item -fill red -font $date::canvasHighlight } set date "$month/$day/$year" } proc numberofdays {month year} { if {$month==12} {set month 1; incr year} clock format [clock scan "[incr month]/1/$year 1 day ago"] \ -format %d } } ;# end namespace date #------ test and demo code (terminate by closing the main window) while 1 { set date [date::choose] puts $date }