I've again (again reinventing the wheel) coded a unix-like "cal" program, this time using fb. Then/later I was asked if I could "internationalize" my code; my response was somewhat more severe than "NO". Below is a qualified "Yes" (proof code), after some thought;
Code: Select all
'printcal, intl - tested using fb v0.15 on XP
option explicit
#include once "windows.bi"
#include once "win\winnls.bi"
declare function printcal(ds as string) as integer
dim dserial as integer
'
'dserial=printcal("01-01-2006")
'dserial=printcal("12-30-1899")
dserial=printcal(date) 'mm-dd-yyyy
'print:print "Serial Date: ";dserial
sleep
'
function printcal(ds as string) as integer
dim as string dstr,fstr,t
dim as integer dow,sdow,ds1,ds2,ndays,res
dim as integer y,yy,m,mm,d,dd,a,c,tds,std
dim stime as SYSTEMTIME
'
y=val(right(ds,4)) 'should be >1582
m=val(left(ds,2))
d=val(mid(ds,4,2))
yy=y:mm=m:dd=d
'
if m<3 then m+=12:y-=1:end if
dow=(2+d+(13*m-2)\5+y+y\4-y\100+y\400) mod 7
tds=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
printcal = tds-693991 'base = 12-30-1899
'
d=1:m=mm:y=yy
if m<3 then m+=12:y-=1:end if
ds1=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
sdow=(2+d+(13*m-2)\5+y+y\4-y\100+y\400) mod 7
'
m=mm:y=yy
m+=1:if m>12 then m=1:y+=1:end if
if m<3 then m+=12:y-=1:end if
ds2=(d+(153*m-2)\5+365*y+y\4-y\100+y\400)
ndays=ds2-ds1 'if dd>ndays then..bad..day
'
dstr=space(16)
GetLocaleInfo(LOCALE_USER_DEFAULT,_
LOCALE_IFIRSTDAYOFWEEK,_
strptr(dstr),_
len(dstr))
std=val(dstr) 'LOCALE_IFIRSTDAYOFWEEK, 0=Monday
'
stime.wYear=yy
stime.wMonth=mm
stime.wDay=dd
dstr=space(256)
10 fstr="MMMM yyyy" & chr(0) 'can reverse "yyyy MMMM"
dstr=space(256)
GetDateFormat(LOCALE_USER_DEFAULT,_
0,_
@stime,_
strptr(fstr),_
strptr(dstr),_
len(dstr))
dstr=trim(dstr)
print:print space(15-len(dstr)\2);dstr
'
t="":fstr="ddd" & chr(0)
stime.wYear=2006
if std=6 then
stime.wMonth=10
else
stime.wMonth=5
endif
for d=1 to 7
stime.wDay=d
dstr=space(16)
GetDateFormat(LOCALE_USER_DEFAULT,_
0,_
@stime,_
strptr(fstr),_
strptr(dstr),_
len(dstr))
dstr=left(trim(dstr),3)
t = t & dstr & space(4-len(dstr))
next
print:print " ";t
'
if std<>6 then
sdow-=1: if sdow<0 then sdow=6:end if
end if
a = 1-sdow:c=0
while a<=ndays
if a>=1 then
color iif(a=dd,15,7),0
print using "####";a;
else
print space(4);
end if
a+=1:c+=1
if c=7 then c=0:print:end if
wend
'
stime.wYear=yy
stime.wMonth=mm
stime.wDay=dd
dstr=space(256)
GetDateFormat(LOCALE_USER_DEFAULT,_
DATE_LONGDATE,_
@stime,_
NULL,_
strptr(dstr),_
len(dstr))
dstr=trim(dstr)
print:print:color 15,0
print space(15-len(dstr)\2);dstr
color 7,0
end function
So.. Does it work outside of my whitebread Americun world?