[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): * I'd really like to see the month name - ''RS: brings in i18n problems, though - month numbers are so universal...'' ''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. * I find partial weeks frustrating. The first week of this month should be: 27 28 29 30 31 1 2 - ''RS: ... but marked in a different color, maybe gray?'' ''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. * It would be nice if it accomodated European weekday ordering with Saturday and Sunday at the end, not split (that is, M,T,W,T,F,S,S, not S,M,T,W,T,R,S). * I'd like clicking a date to select it and close the dialog. ''Easy: add "set date::res $date::date" to the <1> binding - RS'' 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. ---- package require Tk 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 change 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! ---- 2003-03-07 [David Bigelow]: Updated the modified Code to act more like a widget. The "choose" command was altered to accept the path of the widget that launches it (e.g., button). The Calendar selection will popup in a relative position to the widget that you use to launch it. To select a date, Double Click on the desired date, and the formatted date string will be returned by the "choose" function. BTW - Special Thanks for Bryan Oakley for pointing out the vwait to me during the debugging process. Hope everyone finds this a useful and productive widget. 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} variable w .cal proc choose {bpath} { 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 set w $date::w catch {destroy $w} toplevel $w -bg white wm transient $w $bpath set sx [expr [winfo rootx $bpath] + 15] set sy [expr [winfo rooty $bpath] + 5] wm geometry $w "+$sx+$sy" wm title $w "Choose Date:" frame $w.1 entry $w.1.1 -textvar date::month -width 3 -just center button $w.1.2 -text ^ -command {date::adjust 1 0} button $w.1.3 -text v -command {date::adjust -1 0} entry $w.1.4 -textvar date::year -width 4 -just center button $w.1.5 -text ^ -command {date::adjust 0 1} button $w.1.6 -text v -command {date::adjust 0 -1} eval pack [winfo children $w.1] -side left -fill both set canvas [canvas $w.2 -width 160 -height 160 -bg white] # Uncomment the following to include additional controls # frame $w.3 # entry $w.3.1 -textvar date::date -width 10 # button $w.3.2 -text OK -command {set date::res $date::date} # button $w.3.3 -text Cancel -command {set date::res {}} # eval pack [winfo children $w.3] -side left eval pack [winfo children $w] display vwait ::date::res destroy $w 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] switch $x { 20 - 140 {set fillColor pink1} default {set fillColor bisque1} } $canvas create rectangle [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] -fill $fillColor -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 } $canvas bind day { set item [%W find withtag current] set date::day [%W itemcget $item -text] set date::date "$date::month/$date::day/$date::year" set date::res $date::date } } 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 # -- DEMONSTRATION CODE -- # Show a TextBox to Display Results pack [text .tb] -expand y -fill both pack [button .calendar -text "Pick Date" -command { # Note: date::choose {Object to Refernece for Window Position} .tb insert end "SELECTED: [date::choose .calendar]\n" }] pack [button .ex -text "Exit" -bg red -fg white -command {exit}] ---- ---- [Arts and crafts of Tcl-Tk programming] | [Category Package] | [Category Widget] | [Category Date and Time]