Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
DateBox.bi Kalenderfunktionen
| Uploader: |  Muttonhead |
| Datum/Zeit: | 10.05.2010 22:56:55 |
'das Basis-Datum bezieht sich immer auf den 01.01:
'zu definieren ist das Jahr und der Wochentag mit dem es begann
'die Wochentags-Nummerierung ist zu dem des FB-Befehls WEEKDAY kompatibel. So=1,Mo=2 ... Sa=7
'1.Tag des Jahres 2000 war ein Sonnabend
#define BaseYear 2000
#define BaseWeekDay 7
'es kann aber auch jedes andere Jahr als Basis herhalten...
'sollte immer zum gleichen Ergebnis führen!!
'soweit getestet, tut es das auch :)
'Wochentagsnamen definieren
#define DB_Monday "Montag"
#define DB_Tuesday "Dienstag"
#define DB_Wednesday "Mittwoch"
#define DB_Thursday "Donnerstag"
#define DB_Friday "Freitag"
#define DB_Saturday "Samstag"
#define DB_Sunday "Sonntag"
'begin object******************************************************************
type DateBox
private:
DateString as string 'DatumsString gleich dem Format des DATE-Befehls
DateStamp as integer 'TagesStempel, jeder Tag hat bezüglich des BasisDatums(der ist 0) einen eigenen
WeekDayNum as integer 'Wochentagsnummer, FB-Befehl WEEKDAY kompatibel. So=1,Mo=2 ... Sa=7
'alle folgenden Variablen dienen als reine Berechnungshilfen!!!
'Puffer(Counter) zum Ermitteln des Datestrings
TmpDateStamp as integer
'numerische Puffer für Zerlegung des DateStrings in
TmpMonth as integer 'Monat...
TmpDay as integer 'Tag...
TmpYear as integer 'und Jahr
'Tabelle für Monatslängen
TmpMonthTable(1 to 12) as integer
public:
declare constructor ()
declare sub SetDateString(d as string)
declare sub SetDateStamp(s as integer)
declare function GetDateString()as string
declare function GetDateStamp() as integer
declare function GetWeekDay() as integer
declare function GetWeekDayName() as string
declare function CheckDateString(d as string) as integer
private:
declare function LeapYear(y as integer) as integer
declare function YearLength(y as integer) as integer
declare sub ModifyTmpMonthTable(y as integer)
declare sub ParseDateString
declare sub CalcDateStamp
declare sub CalcDateString
declare sub CalcWeekDay
end type
'public methoden***********************
constructor DateBox()
DateString ="01-01-" & str(BaseYear)
DateStamp =0
WeekDayNum =BaseWeekDay
TmpMonthTable(1)=31
ModifyTmpMonthTable(BaseYear)'Februar ans BaseYear anpassen
TmpMonthTable(3)=31
TmpMonthTable(4)=30
TmpMonthTable(5)=31
TmpMonthTable(6)=30
TmpMonthTable(7)=31
TmpMonthTable(8)=31
TmpMonthTable(9)=30
TmpMonthTable(10)=31
TmpMonthTable(11)=30
TmpMonthTable(12)=31
ParseDateString
end constructor
sub DateBox.SetDateString(d as string)
if CheckDateString(d) then
DateString=d
ParseDateString
CalcDateStamp
CalcWeekDay
end if
end sub
sub DateBox.SetDateStamp(s as integer)
DateStamp=s
CalcDateString
CalcWeekDay
end sub
function DateBox.GetDateString()as string
function=DateString
end function
function DateBox.GetDateStamp() as integer
function=DateStamp
end function
function DateBox.GetWeekDay() as integer
function=WeekDayNum
end function
function DateBox.GetWeekDayName() as string
function=""
select case WeekDayNum
case 1
function=DB_Sunday
case 2
function=DB_Monday
case 3
function=DB_Tuesday
case 4
function=DB_Wednesday
case 5
function=DB_Thursday
case 6
function=DB_Friday
case 7
function=DB_Saturday
end select
end function
function DateBox.CheckDateString(d as string) as integer
function=0
dim as integer fail
if (len(d)=10) and (mid(d,3,1)="-") and (mid(d,6,1)="-") then
TmpMonth=val(left(d,2))
TmpDay=val(mid(d,4,2))
TmpYear=val(right(d,4))
ModifyTmpMonthTable(TmpYear)
if TmpMonth>0 and TmpMonth<13 and TmpDay>0 and TmpDay<=TmpMonthTable(TmpMonth) then fail=0 else fail=1
else
fail=1
end if
if fail then
function=0
beep
print"falsches Datum / Datumsformat !"
else
function=1
end if
end function
'private methoden**********************
function DateBox.LeapYear(y as integer) as integer
function=0
if (y mod 4) = 0 then function=1
if ((y mod 100)=0) and ((y mod 400)<>0) then function=0
end function
function DateBox.YearLength(y as integer) as integer
function=365
if LeapYear(y) then function=366
end function
sub DateBox.ModifyTmpMonthTable(y as integer)
if LeapYear(y) then TmpMonthTable(2)=29 else TmpMonthTable(2)=28
end sub
sub DateBox.ParseDateString
if CheckDateString(DateString) then
TmpMonth=val(left(DateString,2))
TmpDay=val(mid(DateString,4,2))
TmpYear=val(right(DateString,4))
end if
end sub
sub DateBox.CalcDateStamp
DateStamp=0
'wenn nötig Jahreslängen addieren(ohne Zieljahr) bzw. subtrahieren(mit Zieljahr)
if TmpYear<>BaseYear then
dim as integer direction=sgn(TmpYear-BaseYear)
if direction=1 then
for i as integer=BaseYear to TmpYear-1
DateStamp +=YearLength(i)
next i
else
for i as integer=BaseYear-1 to TmpYear step -1
DateStamp -=YearLength(i)
next i
end if
end if
'wenn nötig Monatslängen addieren (ohne Zielmonat)
ModifyTmpMonthTable(TmpYear)'Monatslängen auf Zieljahr einstellen
if TmpMonth>1 then
for i as integer=1 to TmpMonth-1
DateStamp +=TmpMonthTable(i)
next i
end if
'Tag im Zielmonat addieren(mit Korrektur)
DateStamp +=TmpDay-1
end sub
sub DateBox.CalcDateString
TmpDateStamp=0
TmpYear=BaseYear
if DateStamp>=YearLength(BaseYear) then
do
TmpDateStamp +=YearLength(TmpYear)
TmpYear +=1
loop until TmpDateStamp + YearLength(TmpYear) >= DateStamp
end if
if DateStamp<0 then
do
TmpYear -=1
TmpDateStamp -=YearLength(TmpYear)
loop until TmpDateStamp <= DateStamp
end if
'Egal welcher der beiden Jahres-Counter grad durchlaufen wurde
'TmpYear ist jetzt unser Zieljahr
'TmpDateStamp steht jetzt auf dem 01.01. des Zieljahres
ModifyTmpMonthTable(TmpYear)'Monatslängen auf Zieljahr einstellen
TmpMonth=1
if DateStamp >= TmpDateStamp+TmpMonthTable(TmpMonth) then
do
TmpDateStamp +=TmpMonthTable(TmpMonth)
TmpMonth +=1
loop until TmpDateStamp + TmpMonthTable(TmpMonth) >= DateStamp
end if
TmpDay=1
if DateStamp > TmpDateStamp then
do
TmpDateStamp +=1
TmpDay +=1
loop until TmpDateStamp = DateStamp
end if
DateString= right("0" & TmpMonth,2) & "-" & right("0" & TmpDay,2) & "-" & right("0000" & TmpYear,4)
end sub
sub DateBox.CalcWeekDay
'da hier modulo benutzt wird und der Rest der Divisionen irgendwann gleich 0 ist, benötigt man auch bei
'der Wochentags-Nummerierung einen "0-Durchgang". Deshalb wird BaseWeekDay um eins verringert benutzt.
'jetzt wird intern mit folgender Zählweise gearbeitet: So=0,Mo=1.....Sa=6
if DateStamp=0 then WeekDayNum=BaseWeekDay-1
if DateStamp>0 then WeekDayNum=(DateStamp+(BaseWeekDay-1)) mod 7
if DateStamp<0 then
WeekDayNum=(BaseWeekDay-1) - (abs(DateStamp) mod 7)
if WeekDayNum<0 then WeekDayNum +=7
end if
'zum Schluß wieder "Aufstocken" zum "WEEKDAY Format" So=1,Mo=2.....Sa=7
WeekDayNum +=1
end sub
'end object********************************************************************