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 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 usefull 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 <Double-Button-1> {
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}]