Home > Archive > PerlTk > December 2005 > DateEntry extension
You are viewing an archived Text-only version of the thread.
To view this thread in it's original format and/or if you want to reply to
this thread please [click here]
| Author |
DateEntry extension
|
|
| Ch Lamprecht 2005-12-14, 7:02 pm |
| Hi,
I wrote a little extension to DateEntry to make it process Dates before
1970. If anyone is intrested, here is it :
package DateEntryDC;
use Date::Pcalc qw(Day_of_W check_date);
use base "Tk::DateEntry";
Tk::Widget->Construct("DateEntryDC");
sub getCalendar{
my ($w) = @_;
my $w =0;
my $cal=[];
for my $mday (1..31) {
if (check_date($w->{_year},$w->{_month},$mday)){
my $wday = Day_of_W ($w->{_year},$w->{_month},$mday)-1;
$wday = ($wday - $w->cget('-w start')) % 7;
$cal->[$w ]->[$wday]=$mday;
if ($wday == 6) {
$w ++;
}
}
}
return $cal;
}
sub updateDate{
my ($w) = shift;
my ($d,$m,$y);
if (check_date($w->{_year},$w->{_month},$w->{_day})){
$y = $w->{_year};
$m = $w->{_month};
$d = $w->{_day};
my $e = $w->Subwidget("entry");
$e->delete('0','end');
$e->insert('end',
$w->Callback(-formatcmd=>$y,$m, $d));
}
}
1;
Christoph
| |
| Jack D 2005-12-15, 3:57 am |
|
"Ch Lamprecht" <christoph.lamprecht.no.spam@web.de> wrote in message
news:dnqbjr$mfu$1@online.de...
> Hi,
> I wrote a little extension to DateEntry to make it process Dates before
> 1970. If anyone is intrested, here is it :
>
> package DateEntryDC;
> use Date::Pcalc qw(Day_of_W check_date);
> use base "Tk::DateEntry";
> Tk::Widget->Construct("DateEntryDC");
> sub getCalendar{
> my ($w) = @_;
> my $w =0;
> my $cal=[];
> for my $mday (1..31) {
> if (check_date($w->{_year},$w->{_month},$mday)){
> my $wday = Day_of_W ($w->{_year},$w->{_month},$mday)-1;
> $wday = ($wday - $w->cget('-w start')) % 7;
> $cal->[$w ]->[$wday]=$mday;
> if ($wday == 6) {
> $w ++;
> }
> }
> }
> return $cal;
> }
>
> sub updateDate{
> my ($w) = shift;
> my ($d,$m,$y);
> if (check_date($w->{_year},$w->{_month},$w->{_day})){
> $y = $w->{_year};
> $m = $w->{_month};
> $d = $w->{_day};
> my $e = $w->Subwidget("entry");
> $e->delete('0','end');
> $e->insert('end',
> $w->Callback(-formatcmd=>$y,$m, $d));
> }
> }
> 1;
Yes - very nice! But where were you last spring when I was searching for
just this? :-)
Out of necessity, I decided to write my own - check it out - you might like
it better.
http://search.cpan.org/~dunniganj/Tk-ChooseDate-0.4/
Jack
| |
| Ch Lamprecht 2005-12-15, 3:57 am |
|
> Out of necessity, I decided to write my own - check it out - you might like
> it better.
>
Thanks a lot, I needed the possibility to let the user edit the content
directly .
> http://search.cpan.org/~dunniganj/Tk-ChooseDate-0.4/
>
> Jack
>
>
Christoph
|
|
|
|
|