Fonte/ Codesnippets | | | | |  |
KompilierenMarkierenSeparierenSource wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Datums-Funktionen
Lauffähig ab Profan-Version 6.6
Hinweis: Dieser Code ist nicht lauffähig, da er nur aus Prozeduren besteht!
Prozedur- und Funktionssammlung zu Datum
ACHTUNG!
========
Für viele Prozeduren und Funktionen wird eine Datumsmanipulation
und -kontrolle nur für einen überschaubaren Bereich vorgenommen.
D. h. nur ab 1901 bis 2099!
Es wird der Befehl BREAK verwendet, also nur für Profan-Versionen,
die diesen Befehl kennen.
------------------------------------------------------------------
declare Century% global vereinbaren
Kontrolliert und steuert die Interpretation von Datumsangaben
ohne Jahrhundertziffern
Syntax:Century%=<nJahr>
<nJahr> gibt das Basisjahr (in 19xx) für eine 100-Jahre-Periode an,
in die alle Datumsangaben, die nur zwei Jahresziffern enthalten,
fallen sollen.
Century%=30 bedeutet also 1930 - 2029
--------------------------------------------------------------------
Array global vereinbaren
declare a_FTG$[14,2] für Feiertage für Land Brandenburg
a_FTG$[1,1]=13
a_FTG$[1,2]=
a_FTG$[2,1]=
a_FTG$[2,2]=Neujahr
a_FTG$[3,1]=
a_FTG$[3,2]=Karfreitag Ostern-2 Tage
a_FTG$[4,1]=
a_FTG$[4,2]=Ostersonntag
a_FTG$[5,1]=
a_FTG$[5,2]=Ostermontag
a_FTG$[6,1]=
a_FTG$[6,2]=Tag der Arbeit erst ab 1933
a_FTG$[7,1]=
a_FTG$[7,2]=Himmelfahrt Ostern+39 Tage
a_FTG$[8,1]=
a_FTG$[8,2]=Pfingstsonntag
a_FTG$[9,1]=
a_FTG$[9,2]=Pfingstmontag
a_FTG$[10,1]=
a_FTG$[10,2]=Tag der Einheit bis 1989 17.6., ab 1990 3.10.
a_FTG$[11,1]=
a_FTG$[11,2]=Reformationstag
a_FTG$[12,1]=
a_FTG$[12,2]=Bußtag nur bis 1994
a_FTG$[13,1]=
a_FTG$[13,2]=1. Weihnachtsfeiertag
a_FTG$[14,1]=
a_FTG$[14,2]=2. Weihnachtsfeiertag
Funktionen
==========
Testet, ob <cDat1> > <cDat2>, <cDatx>=dd.mm.yyyy!
Syntax: DaT1GTDat2(<cDat1>,<cDat2>)
Parameter: <cDat1> ist ein Datum zu dem die Aussage getroffen wird,
ob es größer (später) als das Datum <cDat2> ist.
Rückgabe: 1 falls wahr, sonst 0
DEF Dat1GTDat2(2) if(ctod$($(1))>ctod$($(2)),1,0)
Funktion zur Ermittlung des Systemdatums in der Form tt.mm.jjjj
DEF Heute$() Date$(0)
Ermittelt den Tag eines Datum-Monats
Syntax: DAY%(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem der Tag im Monat
ermittelt werden soll.
Rückgabe: Day%() gibt den Tag des Monats von <cDatum> zurück
DEF Day%(1) val(substr$($(1),1,.))
Ermittelt den Monat eines Datums
Syntax: Month%(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem der Monat
ermittelt werden soll.
Rückgabe: Month%() gibt den Monat von <cDatum> zurück
DEF Month%(1) val(substr$($(1),2,.))
Ermittelt das Jahr eines Datums
Syntax: Year%(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem das Jahr
ermittelt werden soll.
Rückgabe: Year%() gibt das Jahr ([jj]jj je nach Parameter) von <cDatum> zurück
DEF Year%(1) val(substr$($(1),3,.))
Das Datum für den ersten Tag eines Monats ermitteln
Syntax: BOM$(<cDatum>)
Parameter: <cDatum> ist ein Datum, für das der erste Tag des Monats
ermittelt wird, in dem dieses Datum liegt. Ist <cDatum> ein Leerstring,
wird das Systemdatum angenommen
Rückgabe: [0]1.[m]m.[jj]jj, je nach Parameter
DEF BOM$(1) if($(1)=,01+del$(Date$(0),1,instr(.,Date$(0))-1),
01+del$($(1),1,instr(.,$(1))-1))
Das Datum für den Beginn eines Jahres ermitteln, man erspart
sich damit das Anlegen einer Variablen für den 1.1. eines Jahres
Syntax BOY$(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem der erste Tag
eines Jahres ermittelt werden soll. Ist <cDatum> ein Leerstring,
wird das Systemdatum angenommen
Rückgabe: cDatumAnfangJahr 01.01.[jj]jj je nach Parameter
DEF BOY$(1) if($(1)=,01.01.+Substr$(Date$(0),3,.),01.01.+SubStr$($(1),3,.))
Das Datum für das Ende eines Jahres ermitteln, man erspart
sich damit das Anlegen einer Variablen für den 31.12. eines Jahres
Syntax EOY$(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem der letzte Tag
eines Jahres ermittelt werden soll. Ist <cDatum> ein Leerstring,
wird das Systemdatum angenommen
Rückgabe: cDatumAnfangJahr 31.12.[jj]jj je nach Parameter
DEF EOY$(1) if($(1)=,31.12.+Substr$(Date$(0),3,.),31.12.+SubStr$($(1),3,.))
Prüfen, ob ein Jahr ein Schaltjahr ist
Syntax: IsLeap(<cDatum>)
Parameter: <cDatum> ist ein Datum ([t]t.[m]m.[jj]jj), zu dem ermittelt wird. ob
es in einem Schaltjahr liegt
Rückgabe: 1, wenn das <cDatum> in einem Schlatjahr liegt, sonst 0
Datumsbereich 1901 - 2099
DEF IsLeap%(1) if(mod(val(substr$($(1),3,.)),4)=0,1,0)
Prozeduren
==========
Proc AddDay$
-----------
Addiert oder subtrahiert (-)anz% Tage zu dat$
Syntax: AddDay$ <cDatum>,[-]<nAnzahlTage>
Parameter: <cDatum> ist das Datum, zu dem <nAnzahlTage> addiert/subtrahiert
werden sollen.
Rückgabe: <cDatumNeu>
Das Ergebnis ist das neue Datum nach der Addition/Subtraktion von
[-]<nAnzahlTage> zum/vom Datum <cDatum>
Datumsbereich bei 2stelliger Jahresangabe siehe bei Century%
Datumsbereich 4stellig 1901 - 2099
Parameters dat$,anz%
declare hilfdat$,tag%,mon%,jahr%,rc$,Monatstage$
Monatstage$=31,28,31,30,31,30,31,31,30,31,30,31
if isleap%(dat$)
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$(29,Monatstage$,4)
else
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$(28,Monatstage$,4)
endif
tag%=Day%(dat$)
mon%=Month%(dat$)
jahr%=Year%(dat$)
if jahr%<100 Jahresangabe 2stellig
jahr%=if(jahr%<Century%,jahr%+2000,jahr%+1900)
endif
if anz%>=0 addieren
While anz%<>0
inc tag%
if tag%>vaL(Substr$(Monatstage$,mon%,,))
tag%=1
inc mon%
if mon%>12
mon%=1
inc jahr%
hilfdat$=1.1.+str$(jahr%)
if isleap%(hilfdat$) Schaltjahr
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$(29,Monatstage$,4)
else
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$(28,Monatstage$,4)
endif
endif
endif
dec anz%
EndWhile
else subtrahieren
anz%=abs(anz%)
While anz%<>0
dec tag%
if tag%=0
dec mon%
if mon%=0
mon%=12
tag%=31
dec jahr%
hilfdat$=31.12.+str$(jahr%)
if isleap%(hilfdat$) Schaltjahr
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$(29,Monatstage$,4)
else
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$(28,Monatstage$,4)
endif
else
tag%=vaL(Substr$(Monatstage$,mon%,,))
endif
endif
dec anz%
EndWhile
endif
rc$=format$(00,tag%)+.+format$(00,mon%)+.+str$(jahr%)
return rc$
EndProc AddDay$
Proc Ostern_ist$
---------------
Ermittelt das Osterdatum von <nJahr>
Syntax: OsternIst <nJahr>
Parameter: <nJahr> ist eine 4stellige Jahresangabe
Rückgabe ist das Osterdatum in der Form tt.mm.jjjj
Parameters jahr%
declare d%,e%,monat%,tag%,rc$
d%=mod((19*mod(jahr%,19)+24),30)
e%=mod(2*mod(jahr%,4)+4*mod(jahr%,7)+6*d%+5,7)
monat%=3
tag%=22+d%+e%
if tag%>31
tag%=d%+e%-9
inc monat%
endif
if (monat%=4) and ((tag%=26) or ((tag%=25) and (d%=28) and (mod(jahr%,19)<10)))
tag%=tag%-7
endif
rc$=format$(00,tag%);.;format$(00,monat%);.;format$(0000,jahr%)
return rc$
EndProc Ostern_ist$
Proc DOW
-------
Errechnet die Wochentagsnummer aus einem Datum
Syntax: DOW [<cDatum>]; Vorgabe Systemdatum
Parameter: <cDatum> ist ein Datumswert von dem der Wochentag ermittelt
werden soll.
Rückgabe ist die Wochentagsnummer 0=So,1=Mo.,2=Di.,...6=Sa.
Datumsbereich bei 2stelliger Jahresangabe, siehe bei Century%
Datumsbereich 4stellig 1901 - 2099
Parameters Datum$
declare t%,m%,j%,rc%,h1&
if %PCount=0
Datum$=Date$(0)
endif
t%=day%(datum$)
m%=month%(datum$)
j%=year%(datum$)
if j%<100 Jahresangabe 2stellig
j%=if(j%<Century%,j%+2000,j%+1900)
endif
j%=j%-1
h1&=(j%)*365
h1&=h1&+int((j%)/4) Schaltj
h1&=h1&-int(j%/100) kein Schaltj.
h1&=h1&+int(j%/400) Schaltj.
if (mod((j%+1),4)=0) and (m%>2) akt.Jahr=Schaltjahr
h1&=h1&+1
endif
case m%=1 : h1&=h1&+t%
case m%=2 : h1&=h1&+31+t%
case m%=3 : h1&=h1&+59+t%
case m%=4 : h1&=h1&+90+t%
case m%=5 : h1&=h1&+120+t%
case m%=6 : h1&=h1&+151+t%
case m%=7 : h1&=h1&+181+t%
case m%=8 : h1&=h1&+212+t%
case m%=9 : h1&=h1&+243+t%
case m%=10 : h1&=h1&+273+t%
case m%=11 : h1&=h1&+304+t%
case m%=12 : h1&=h1&+334+t%
rc%=mod(h1&,7)
return rc%
EndProc DOW
Proc NToCDow$
-----------_
Wandelt eine Wochentagsnummer in einen Wochentagsnamen
Syntax NToCDow$ <nTagNummer>,<nDarstellung>
Parameter <nTagNummer> Wert wie in Prozedur DOW 0=So,1=Mo,...6=Sa
<nDarstellung> ist ein Parameter, wie die Darstellung des Wochentagsnamen
erfolgen soll. Ist <nDarstellung>=0, wird der Wochentag als Abkürzung Mo.,Di. ...
geliefert, ist <nDarstellung>=1, wird der volle Namen geliefert
1=Montag,Dienstag...
Rückgabe: der Name des Wochentages Mo. oder Montag ...
parameters tagNr%,wie%
declare rc$
if wie%=0
case tagnr%=0 : rc$=So.
case tagnr%=1 : rc$=Mo.
case tagnr%=2 : rc$=Di.
case tagnr%=3 : rc$=Mi.
case tagnr%=4 : rc$=Do.
case tagnr%=5 : rc$=Fr.
case tagnr%=6 : rc$=Sa.
else
case tagnr%=0 : rc$=Sonntag
case tagnr%=1 : rc$=Montag
case tagnr%=2 : rc$=Dienstag
case tagnr%=3 : rc$=Mittwoch
case tagnr%=4 : rc$=Donnerstag
case tagnr%=5 : rc$=Freitag
case tagnr%=6 : rc$=Sonnabend
endif
return rc$
EndProc NtoCDow$
PROC LastDayOM
-------------
Ermittelt den letzten Tag eines Monats als Zahl
Syntax: LastDayOM [<cDatum>]
Parameter ein Datum [t]t.[m]m.[jj]jj; Vorgabe Systemdatum
Rückgabe: <nTageImMonat>
Datumsbereich 1901 - 2099
Parameters dat$
declare rc%,Monatstage$
Monatstage$=31,28,31,30,31,30,31,31,30,31,30,31
if %PCount=0
dat$=Date$(0)
endif
rc%=val(SubStr$(Monatstage$,Month%(dat$),,))
case Isleap%(dat$) and (Month%(dat$)=2) : rc%=rc%+1
return rc%
EndProc LastDayOM
PROC NToCMonth$
--------------
Wandelt eine Monatsnummer in einen Monatsnamen
Syntax: NToCMonth$ <nMonat>
Parameter: <nMonat> ist eine Monatszahl, zu der ein Monatsname
geliefert wird. Ein fehlerhafter Parameter ergibt
Rückgabe: <cMonat> entspricht dem zu der angegebenen Monatszahl
<nMonat> korrespondierenden Monatsnamen
parameters mon%
declare rc$
if (mon%<1) or (mon%>12)
rc$=
else
case mon%=1 : rc$=Januar
case mon%=2 : rc$=Februar
case mon%=3 : rc$=März
case mon%=4 : rc$=April
case mon%=5 : rc$=Mai
case mon%=6 : rc$=Juni
case mon%=7 : rc$=Juli
case mon%=8 : rc$=August
case mon%=9 : rc$=September
case mon%=10 : rc$=Oktober
case mon%=11 : rc$=November
case mon%=12 : rc$=Dezember
endif
return rc$
EndProc NToCMonth$
Proc AddMonth$
-------------
Monate zu einem Datum addieren bzw subtrahieren
Syntax: AddMonth$ <cDatum>,<nMonate> -> cDatumNeu
Parameter: <cDatum> ist das Datum (mit 4stelliger Jahreszahl),
zu dem <nMonate> Monate addiert/subtrahiert werden.
Ist <cDatum> ein Leerstring, wird das Systemdatum angenommen
Negative <nMonate> klammern: (-x)
Rückgabe: Das neue Datum tt.mm.jjjj
Parameters dat$,anz%
declare tag%,monat%,jahr%,z%,plusmon%,plusj%,rc$,lom%
if dat$=
dat$=Date$(0)
endif
tag%=Day%(dat$)
monat%=Month%(dat$)
jahr%=Year%(dat$)
plusmon%=mod(abs(anz%),12)
plusj%=int(abs(anz%)/12)
if anz%<0
if (monat%-plusmon%)<1
inc plusj%
monat%=monat%-plusmon%+12
else
monat%=monat%-plusmon%
endif
jahr%=jahr%-plusj%
else
if (monat%+plusmon%)>12
inc plusj%
monat%=monat%+plusmon%-12
else
monat%=monat%+plusmon%
endif
jahr%=jahr%+plusj%
endif
rc$=format$(00,tag%)+.+format$(00,monat%)+.+format$(0000,jahr%)
LastDayOM rc$
if %(0)<tag%
tag%=%(0)
rc$=format$(00,tag%)+.+format$(00,monat%)+.+format$(0000,jahr%)
endif
Return rc$
EndProc AddMonth$
Proc ScanFTG
-----------
Prüft, ob das übergebene Datum ein Feiertag in a_FTG$ ist
Syntax ScanFTG <cDatum>
Parameter: <cDatum> ist ein Datum, zu dem geprüft werden soll,
ob es ein Feiertag ist
Rückgabe 1, wenn <cDatum> ein Feiertag ist, sonst 0
parameters dat$
declare z%,rc%
z%=2
rc%=0
While z% < (val(a_FTG$[1,1])+2)
if dat$=a_FTG$[z%,1]
rc%=1
z%=100
endif
inc z%
EndWhile
return rc%
EndProc ScanFTG
Proc Feiertage
-------------
Ermittelt alle Feiertage
Benötigt Arrayvereinbarung a_FTG[x,2] [Datum,Name]
In a_FTG$[1,1]steht die Anzahl der eingetragenen Feiertage als ZK(!),
damit ist die Länge x des Array um 1 größer, als die Anzahl der
Feiertage.
In a_FTG$[n,1] steht das Datum, in a_FTG$[n,2] der Name
Parameters ostern$
ist das Osterdatum mit 4stelliger Jahreszahl!
==========
declare j%,j$,hilfdat$
j%=Year%(ostern$)
j$=str$(j%)
a_FTG$[2,1]=01.01.+j$
hilfdat$=ostern$
AddDay$ ostern$,(-2)
a_FTG$[3,1]=$(0)
a_FTG$[4,1]=ostern$
AddDay$ ostern$,1
a_FTG$[5,1]=$(0)
if j%>1932
a_FTG$[6,1]=01.05.+j$
else
a_FTG$[6,1]=
endif
AddDay$ ostern$,39
a_FTG$[7,1]=$(0)
AddDay$ ostern$,49
a_FTG$[8,1]=$(0)
AddDay$ ostern$,50
a_FTG$[9,1]=$(0)
if j%<1990
a_FTG$[10,1]=17.06.+j$
else
a_FTG$[10,1]=03.10.+j$
endif
a_FTG$[13,1]=25.12.+j$
a_FTG$[14,1]=26.12.+j$
Bußtag nur bis 1994
if j%<1995
hilfdat$=24.12.+j$
DOW hilfdat$
AddDay$ hilfdat$,(-(%(0)+32))
a_FTG$[12,1]=$(0)
else
a_FTG$[12,1]=
endif
a_FTG$[11,1]=31.10.+j$
EndProc Feiertage
Proc KontrolleDatum$
-------------------
kontrolliert die Plausibilität eines Datums
und setzt eine 2stellige Jahreszahl 4stellig
Syntax: KontrolleDatum$ <cDatum>
Parameter: <cDatum> ist das zu kontrollierende Datum
Datumsbereich bei 2stelliger Jahresangabe siehe bei Century%
Jahresangabe 1stellig und 3stellig nicht zulässig
Jahresangabe 1901 - 2099
Rückgabewert Datum OK, das Datum als tt.mm.jjjj
Datum fehlerhaft,
parameters Datum$
declare lg%,z1%,z2%,rc%,ZulZ$,lgZZ%,AnzP%,tag%,monat%,jahr%
declare Monatstage$,ultimo%,rc$
Monatstage$=31,28,31,30,31,30,31,31,30,31,30,31
lg%=len(Datum$)
ZulZ$=0123456789.
lgZZ%=len(ZulZ$)
z1%=1
z2%=1
AnzP%=0
rc%=0
Zahlen und Punkt testen
WhileNot z1%>lg%
rc%=0
WhileNot z2%>lgZZ%
if Mid$(Datum$,z1%,1)=Mid$(ZulZ$,z2%,1)
rc%=1
z2%=lgZZ%
endif
inc z2%
EndWhile
if rc%=0
break
endif
inc z1%
z2%=1
EndWhile
Anzahl Punkte testen
if rc%=1
AnzP%=len(Datum$)-len(translate$(Datum$,.,))
case AnzP%<>2 : rc%=0
endif
Monat testen
if rc%=1
if (Month%(Datum$)<1) or (Month%(Datum$)>12)
rc%=0
endif
endif
Jahr testen
case len(SubStr$(Datum$,3,.))=1 : rc%=0
case len(SubStr$(Datum$,3,.))=3 : rc%=0
if rc%=1
jahr%=Year%(Datum$)
if jahr%<100 Jahresangabe 2stellig
jahr%=if(jahr%<Century%,jahr%+2000,jahr%+1900)
endif
if jahr%<1901
rc%=0
endif
endif
Tag des Monats testen
if rc%=1
if mod(jahr%,4)=0
Monatstage$=Translate$(Monatstage$,28,29)
endif
tag%=Day%(Datum$)
monat%=Month%(Datum$)
ultimo%=val(SubStr$(Monatstage$,monat%,,))
if (tag%<1) or (tag%>ultimo%)
rc%=0
endif
endif
if rc%=1
rc$=Format$(00,tag%)+.+Format$(00,monat%)+.+Format$(0000,jahr%)
else
rc$=
endif
return rc$
EndProc KontrolleDatum$
Proc DOY
-------
Der Tag des Jahres zu einem Datum
Syntax: DOY [<cDatum>]
Parameter: <cDatum> ist das Datum, zu dem eine Tages-Seriennummer
ermittelt werden soll. Vorgabe Systemdatum
Rückgabe:<nTagImJahr> Die Zahl ist eine Tages-Seriennummer und gibt an,
der wievielte Tag in einem Jahr durch das Datum <cDatum> spezifiziert wird.
Beispiel: Berechnung des Abstandes zwischen heute und dem Beginn des Quartals,
in dem heute liegt.
doy
t1%=%(0)
boq$
doy $(0)
abstand%=t1%-%(0)
parameters dat$
declare rc%,SuTg$
if %PCount=0
dat$=date$(0)
endif
SuTg$=0,31,59,90,120,151,181,212,243,273,304,334
if month%(dat$)>2
rc%=val(SubStr$(SuTg$,month%(dat$),,))+day%(dat$)+IsLeap%(dat$)
else
rc%=val(SubStr$(SuTg$,month%(dat$),,))+day%(dat$)
endif
return rc%
EndProc DOY
Proc BOQ$
--------
Das Datum für einen Quartalsbeginn ermitteln
Syntax: BOQ$ [<cDatum>] -> cDatumAnfangQuartal
Parameter: <cDatum> ist ein Datum, für das der erste Tag des Quartals
ermittelt wird, in dem dieses Datum liegt. Vorgabe Systemdatum
Rückgabe: cDatumAnfangQuartal
parameters dat$
declare rc$,monat%,monat$
if %PCount=0
dat$=date$(0)
endif
monat%=val(substr$(dat$,2,.))
if monat%<4
monat$=01.
elseif monat%<7
monat$=04.
elseif monat%<10
monat$=07.
else
monat$=10.
endif
rc$=01.+monat$+substr$(dat$,3,.)
return rc$
EndProc BOQ$
Proc Quarter
------------
Ermittelt, in welchem Quartal ein Datum liegt
Syntax: Quarter [<cDatum>]
Parameter: <cDatum> ist ein Datum, für das ermittelt wird, in welchem
Quartal des Jahres es liegt. Vorgabe Systemdatum
Rückgabe: Die Nummer des Quartals
parameters dat$
declare rc%,monat%
if %PCount=0
dat$=date$(0)
endif
monat%=val(substr$(dat$,2,.))
if monat%<4
rc%=1
elseif monat%<7
rc%=2
elseif monat%<10
rc%=3
else
rc%=4
endif
return rc%
EndProc Quarter
Proc CToDOW
----------
Wochentagsnamen in korespondierende Nummer umwandeln
Syntax: CToDOW <cWochentag>
Parameter: <cWochentag> ist eine Zeichenkette, die einen Wochentags-
namen enthält. Groß- und Kleinschreibung spielt keine Rolle.
Der Wochentagsname kann abgekürzt werden, diese Abkürzungen müssen
jedoch eindeutig sein. Liefert die Prozedur 9 zurück, wurde ein
ungültiger Name übergeben.
Rückgabe <nWochentag> 0=Sonntag, 1=Montag,...,6=Samstag/Sonnabend
parameters zk$
declare rc%,tage$,z%
rc%=0
tage$=SONNTAG/MONTAG/DIENSTAG/MITTWOCH/DONNERSTAG/FREITAG/SAMSTAG/SONNABEND
z%=1
While z%<9
if Instr(Upper$(zk$),SubStr$(tage$,z%,/))=1
rc%=z%
break
endif
inc z%
EndWhile
if rc%=0 Fehler
rc%=9
elseif rc%=8 Sonnabend gefunden
rc%=6
else
dec rc%
endif
return rc%
EndProc CToDOW
Proc CToMonth
------------
Monatssnamen in korespondierende Nummer umwandeln
Syntax: CToMONTH <cMonat>
Parameter: <cMonat> ist eine Zeichenkette, die einen Monats-
namen enthält. Groß- und Kleinschreibung spielt keine Rolle.
Der Monatsname kann abgekürzt werden, diese Abkürzungen müssen
jedoch eindeutig sein. Liefert die Prozedur 0 zurück, wurde ein
ungültiger Name übergeben.
Rückgabe <nMonat> 1 - 12
parameters zk$
declare monat$,z%,rc%
monat$=JANUAR/FEBRUAR/MÄRZ/APRIL/MAI/JUNI/JULI/AUGUST/SEPTEMBER/
OKTOBER/NOVEMBER/DEZEMBER
rc%=0
z%=1
While z%<13
if Instr(Upper$(zk$),SubStr$(monat$,z%,/))=1
rc%=z%
break
endif
inc z%
EndWhile
return rc%
EndProc CToMONTH
Proc DMY$
--------
Liefert ein Datum im Format tt. Monat jjjj
Syntax: DMY$ [<cDatum>]
Parameter: <cDatum> ist ein gültiges Datum, zu dem ein String erzeugt
werden soll. Vorgabe Systemdatum
Rückgabe: Die Zeichenkette [t]t. Monat [jj]jj je nach Übergabeparameter
parameters dat$
declare monat$,rc$
monat$=Januar/Februar/März/April/Mai/Juni/Juli/August/September/
Oktober/November/Dezember
if %PCount=0
dat$=date$(0)
endif
rc$=SubStr$(dat$,1,.)+. +SubStr$(monat$,val(SubStr$(dat$,2,.)),/)
+ +SubStr$(dat$,3,.)
return rc$
EndProc DMY$
Proc Week
--------
Liefert die Wochennummer zu einem Datum
Syntax: Week [cDatum] -> nWocheImJahr
Parameter: <cDatum> ist ein Datum, für das ermittelt wird,
in der wievielten Woche des Jahres es liegt. Vorgabe Systemdatum
Rückgabe: nWocheImJahr
Gültigkeitsbereich 1901 bis 2099 !!!
Parameter dat$ mit 4stelliger Jahreszahl
DIN 1355
Der Montag ist der erste Tag der Woche.
Eine Woche gehört zu demjenigen Kalenderjahr, in dem 3 oder mehr Tage
der Woche liegen
Der Donnerstag einer Woche liegt immer in demjenigen Kalenderjahr, dem
die Woche zugerechnet wird.
Der 4. Januar liegt immer in der ersten KW.
Der 28. Dezember liegt immer in der letzten KW.
parameters dat$
declare wtgnr%,wtgnj%,sn%,neujahr$,jahr%
declare rc% ist die Kalenderwoche
if %PCount=0
dat$=date$(0)
endif
rc%=0
jahr%=year%(dat$)
if (jahr%>1900) and (jahr%<2100)
neujahr$=BOY$(dat$)
DOW neujahr$
wtgnj%=if(%(0)=0,7,%(0)) Neuj.: So. wird WoTagnr. 7
DOY dat$
sn%=%(0) Seriennummer akt. Datum
DOW dat$
wtgnr%=if(%(0)=0,7,%(0)) akt. Datum: So. wird WoTagnr. 7
Kein Schaltjahr
if mod(jahr%,4) <> 0
if wtgnj%=1 Jahr beginnt mit Mo.
rc%=int((sn%-wtgnj%)/7)+1
case sn%=365 : rc%=1
elseif wtgnj%=2 Jahr beginnt mit Di.
if (sn% >= 364) or (sn%<7)
rc%=1
else
rc%=int((sn%-7)/7)+2
endif
elseif wtgnj%=3 Jahr beginnt mit Mi.
if (sn% >= 363) or (sn%<6)
rc%=1
else
rc%=int((sn%-6)/7)+2
endif
elseif wtgnj%=4 Jahr beginnt mit Do.
if sn%<5
rc%=1
else
rc%=int((sn%-5)/7)+2
endif
elseif wtgnj%=5 Jahr beginnt mit Fr.
if sn%<4
rc%=53
else
rc%=int((sn%-4)/7)+1
endif
elseif wtgnj%=6 Jahr beginnt mit Sa.
if sn%<3
rc%=if(mod(jahr%,4)=1,53,52) wenn Neujahr=Sa. UND Jahr von dat$
einem Schaltjahr folgt
else
rc%=int((sn%-3)/7)+1
endif
elseif wtgnj%=7 Jahr beginnt mit So.
if sn%<2
rc%=52
else
rc%=int((sn%-2)/7)+1
endif
endif
else Schaltjahr
if wtgnj%=1 Jahr beginnt mit Mo.
rc%=int((sn%-wtgnj%)/7)+1
case sn% >= 365 : rc%=1
elseif wtgnj%=2 Jahr beginnt mit Di.
if (sn% >= 364) or (sn%<7)
rc%=1
else
rc%=int((sn%-7)/7)+2
endif
elseif wtgnj%=3 Jahr beginnt mit Mi.
if sn%<6
rc%=1
else
rc%=int((sn%-6)/7)+2
endif
elseif wtgnj%=4 Jahr beginnt mit Do.
if sn%<5
rc%=1
else
rc%=int((sn%-5)/7)+2
endif
elseif wtgnj%=5 Jahr beginnt mit Fr.
if sn%<4
rc%=53
else
rc%=int((sn%-4)/7)+1
endif
elseif wtgnj%=6 Jahr beginnt mit Sa.
if sn%<3
rc%=52
else
rc%=int((sn%-3)/7)+1
endif
elseif wtgnj%=7 Jahr beginnt mit So.
if sn%<2
rc%=52
elseif sn%=366
rc%=1
else
rc%=int((sn%-2)/7)+1
endif
endif
endif
endif
return rc%
EndProc wnr
Proc EOM$
--------
Das Datum für den letzten Tag eines Monats ermitteln
Syntax: EOM$ [<cDatum>]
Parameter: <cDatum> ist ein Datum, für das der letzte Tag des Monats
ermittelt wird, in dem es liegt. Vorgabe Systemdatum
Rückgabe: <cDatumEndeMonat> tt.[m]m.[jj]jj je nach Parameter
Gültigkeitsbereich <cDatum> 1901 - 2099
parameters dat$
declare rc$
if %PCount=0
dat$=date$(0)
endif
LastDayOM dat$
rc$=format$(00,%(0))+.+SubStr$(dat$,2,.)+.+SubStr$(dat$,3,.)
return rc$
EndProc EOM$
Proc EOQ$
--------
Das Datum für das Ende eines Quartals ermitteln
Syntax: EOQ$ [<cDatum>]
Parameter: <cDatum> ist ein Datum, für das der letzte Tag des Quartals
ermittelt wird, in dem es liegt. Vorgabe Systemdatum
Rückgabe: <cDatumEndeQuartal> tt.mm.[jj]jj je nach Parameter
parameters dat$
declare rc$,monat%,ende$
if %PCount=0
dat$=date$(0)
endif
monat%=val(substr$(dat$,2,.))
if monat%<4
ende$=31.03.
elseif monat%<7
ende$=30.06.
elseif monat%<10
ende$=30.09.
else
ende$=31.12.
endif
rc$=ende$+substr$(dat$,3,.)
return rc$
EndProc EOQ$
Proc CDOW$
---------
Ermittelt den Wochentagsnamen eines Datums
Syntax: CDOW$ [<cDatum>]
Parameter: <cDatum> ist ein Datum, zu dem der Wochentagsnamen
ermittelt werden soll. Vorgabe Systemdatum
Rückgabe: <cWochentag>
parameters dat$
declare rc$,wtg$
wtg$=Sonntag,Montag,Dienstag,Mittwoch,Donnerstag,Freitag,Sonnabend
if %PCount=0
dat$=date$(0)
endif
DOW dat$
rc$=SubStr$(wtg$,%(0)+1,,)
return rc$
EndProc CDOW$
Proc CMonth$
-----------
Ermittelt den Monatsnamen zu einem Datum
Syntax: CMonth$ [<cDatum>]
Parameter: <cDatum> ist ein Datum, zu dem der Monatsnamen
ermittelt werden soll. Vorgabe Systemdatum
Rückgabe: <cMonatsname>
parameters dat$
declare rc$,mon$
mon$=Januar,Februar,März,April,Mai,Juni,Juli,August,September,
Oktober,November,Dezember
if % PCount=0
dat$ =date$(0)
endif
rc$ =SubStr$(mon$,Month% (dat$ ),, )
return rc$
EndProc cMonth$
|
| | | | | | |
| | 
Jörg
Sellmeyer | Hier mal die bereinigte Version, da ab XProfan z.B. Mod(x,y) nicht mehr funktioniert.
KompilierenMarkierenSeparierenSource wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Datums-Funktionen
Lauffähig ab Profan-Version 6.6
Hinweis: Dieser Code ist nicht lauffähig, da er nur aus Prozeduren besteht!
Prozedur- und Funktionssammlung zu Datum
ACHTUNG!
========
Für viele Prozeduren und Funktionen wird eine Datumsmanipulation
und -kontrolle nur für einen "überschaubaren" Bereich vorgenommen.
D. h. nur ab 1901 bis 2099!
Es wird der Befehl BREAK verwendet, also nur für Profan-Versionen,
die diesen Befehl kennen.
------------------------------------------------------------------
declare Century%global vereinbaren
Kontrolliert und steuert die Interpretation von Datumsangaben
ohne Jahrhundertziffern
Syntax:Century%=<nJahr>
<nJahr> gibt das Basisjahr (in 19xx) für eine 100-Jahre-Periode an,
in die alle Datumsangaben, die nur zwei Jahresziffern enthalten,
fallen sollen.
Century%=30bedeutet also 1930 - 2029
--------------------------------------------------------------------
Array global vereinbaren
declare a_FTG$[14,2]für Feiertage für Land Brandenburg
a_FTG$[1,1]="13"
a_FTG$[1,2]=""
a_FTG$[2,1]=""
a_FTG$[2,2]="Neujahr"
a_FTG$[3,1]=""
a_FTG$[3,2]="Karfreitag"Ostern-2 Tage
a_FTG$[4,1]=""
a_FTG$[4,2]="Ostersonntag"
a_FTG$[5,1]=""
a_FTG$[5,2]="Ostermontag"
a_FTG$[6,1]=""
a_FTG$[6,2]="Tag der Arbeit"erst ab 1933
a_FTG$[7,1]=""
a_FTG$[7,2]="Himmelfahrt"Ostern+39 Tage
a_FTG$[8,1]=""
a_FTG$[8,2]="Pfingstsonntag"
a_FTG$[9,1]=""
a_FTG$[9,2]="Pfingstmontag"
a_FTG$[10,1]=""
a_FTG$[10,2]="Tag der Einheit"bis 1989 17.6., ab 1990 3.10.
a_FTG$[11,1]=""
a_FTG$[11,2]="Reformationstag"
a_FTG$[12,1]=""
a_FTG$[12,2]="Bußtag"nur bis 1994
a_FTG$[13,1]=""
a_FTG$[13,2]="1. Weihnachtsfeiertag"
a_FTG$[14,1]=""
a_FTG$[14,2]="2. Weihnachtsfeiertag"
Funktionen
==========
Testet, ob <cDat1> > <cDat2>, <cDatx>="dd.mm.yyyy"!
Syntax: DaT1GTDat2(<cDat1>,<cDat2>)
Parameter: <cDat1> ist ein Datum zu dem die Aussage getroffen wird,
ob es größer (später) als das Datum <cDat2> ist.
Rückgabe: 1 falls wahr, sonst 0
DEF Dat1GTDat2(2) if(ctod$($(1))>ctod$($(2)),1,0)
Funktion zur Ermittlung des Systemdatums in der Form "tt.mm.jjjj"
DEF Heute$() Date$(0)
Ermittelt den Tag eines Datum-Monats
Syntax: DAY%(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem der Tag im Monat
ermittelt werden soll.
Rückgabe: Day%() gibt den Tag des Monats von <cDatum> zurück
DEF Day%(1) val(substr$($(1),1,"."))
Ermittelt den Monat eines Datums
Syntax: Month%(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem der Monat
ermittelt werden soll.
Rückgabe: Month%() gibt den Monat von <cDatum> zurück
DEF Month%(1) val(substr$($(1),2,"."))
Ermittelt das Jahr eines Datums
Syntax: Year%(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem das Jahr
ermittelt werden soll.
Rückgabe: Year%() gibt das Jahr ([jj]jj je nach Parameter) von <cDatum> zurück
DEF Year%(1) val(substr$($(1),3,"."))
Das Datum für den ersten Tag eines Monats ermitteln
Syntax: BOM$(<cDatum>)
Parameter: <cDatum> ist ein Datum, für das der erste Tag des Monats
ermittelt wird, in dem dieses Datum liegt. Ist <cDatum> ein Leerstring,
wird das Systemdatum angenommen
Rückgabe: "[0]1.[m]m.[jj]jj", je nach Parameter
DEF BOM$(1) if($(1)="","01"+del$(Date$(0),1,instr(".",Date$(0))-1),
"01"+del$($(1),1,instr(".",$(1))-1))
Das Datum für den Beginn eines Jahres ermitteln, man erspart
sich damit das Anlegen einer Variablen für den 1.1. eines Jahres
Syntax BOY$(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem der erste Tag
eines Jahres ermittelt werden soll. Ist <cDatum> ein Leerstring,
wird das Systemdatum angenommen
Rückgabe: cDatumAnfangJahr "01.01.[jj]jj" je nach Parameter
DEF BOY$(1) if($(1)="","01.01."+Substr$(Date$(0),3,"."),"01.01."+SubStr$($(1),3,"."))
Das Datum für das Ende eines Jahres ermitteln, man erspart
sich damit das Anlegen einer Variablen für den 31.12. eines Jahres
Syntax EOY$(<cDatum>)
Parameter: <cDatum> ist das Datum, zu dem der letzte Tag
eines Jahres ermittelt werden soll. Ist <cDatum> ein Leerstring,
wird das Systemdatum angenommen
Rückgabe: cDatumAnfangJahr "31.12.[jj]jj" je nach Parameter
DEF EOY$(1) if($(1)="","31.12."+Substr$(Date$(0),3,"."),"31.12."+SubStr$($(1),3,"."))
Prüfen, ob ein Jahr ein Schaltjahr ist
Syntax: IsLeap(<cDatum>)
Parameter: <cDatum> ist ein Datum ("[t]t.[m]m.[jj]jj"), zu dem ermittelt wird. ob
es in einem Schaltjahr liegt
Rückgabe: 1, wenn das <cDatum> in einem Schlatjahr liegt, sonst 0
Datumsbereich 1901 - 2099
DEF IsLeap%(1) if((val(substr$($(1),3,".")) Mod 4)=0,1,0)
Prozeduren
==========
Proc AddDay$
-----------
Addiert oder subtrahiert (-)anz% Tage zu dat$
Syntax: AddDay$ <cDatum>,[-]<nAnzahlTage>
Parameter: <cDatum> ist das Datum, zu dem <nAnzahlTage> addiert/subtrahiert
werden sollen.
Rückgabe: <cDatumNeu>
Das Ergebnis ist das neue Datum nach der Addition/Subtraktion von
[-]<nAnzahlTage> zum/vom Datum <cDatum>
Datumsbereich bei 2stelliger Jahresangabe siehe bei Century%
Datumsbereich 4stellig 1901 - 2099
Parameters dat$,anz%
declare hilfdat$,tag%,mon%,jahr%,rc$,Monatstage$
Monatstage$="31,28,31,30,31,30,31,31,30,31,30,31"
if isleap%(dat$)
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$("29",Monatstage$,4)
else
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$("28",Monatstage$,4)
endif
tag%=Day%(dat$)
mon%=Month%(dat$)
jahr%=Year%(dat$)
if jahr%<100Jahresangabe 2stellig
jahr%=if(jahr%<Century%,jahr%+2000,jahr%+1900)
endif
if anz%>=0addieren
While anz%<>0
inc tag%
if tag%>vaL(Substr$(Monatstage$,mon%,","))
tag%=1
inc mon%
if mon%>12
mon%=1
inc jahr%
hilfdat$="1.1."+str$(jahr%)
if isleap%(hilfdat$)Schaltjahr
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$("29",Monatstage$,4)
else
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$("28",Monatstage$,4)
endif
endif
endif
dec anz%
EndWhile
elsesubtrahieren
anz%=abs(anz%)
While anz%<>0
dec tag%
if tag%=0
dec mon%
if mon%=0
mon%=12
tag%=31
dec jahr%
hilfdat$="31.12."+str$(jahr%)
if isleap%(hilfdat$)Schaltjahr
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$("29",Monatstage$,4)
else
Monatstage$=Del$(Monatstage$,4,2)
Monatstage$=Ins$("28",Monatstage$,4)
endif
else
tag%=vaL(Substr$(Monatstage$,mon%,","))
endif
endif
dec anz%
EndWhile
endif
rc$=format$("00",tag%)+"."+format$("00",mon%)+"."+str$(jahr%)
return rc$
EndProcAddDay$
Proc Ostern_ist$
---------------
Ermittelt das Osterdatum von <nJahr>
Syntax: OsternIst <nJahr>
Parameter: <nJahr> ist eine 4stellige Jahresangabe
Rückgabe ist das Osterdatum in der Form "tt.mm.jjjj"
Parameters jahr%
declare d%,e%,monat%,tag%,rc$
d%=((19*(jahr% Mod 19)+24) Mod 30)
e%=mod(2*(jahr% Mod 4)+4*(jahr% Mod 7)+6*d%+5,7)
monat%=3
tag%=22+d%+e%
if tag%>31
tag%=d%+e%-9
inc monat%
endif
if (monat%=4) and ((tag%=26) or ((tag%=25) and (d%=28) and ((jahr% Mod 19)<10)))
tag%=tag%-7
endif
rc$=format$("00",tag%);".";format$("00",monat%);".";format$("0000",jahr%)
return rc$
EndProcOstern_ist$
Proc DOW
-------
Errechnet die Wochentagsnummer aus einem Datum
Syntax: DOW [<cDatum>]; Vorgabe Systemdatum
Parameter: <cDatum> ist ein Datumswert von dem der Wochentag ermittelt
werden soll.
Rückgabe ist die Wochentagsnummer 0=So,1=Mo.,2=Di.,...6=Sa.
Datumsbereich bei 2stelliger Jahresangabe, siehe bei Century%
Datumsbereich 4stellig 1901 - 2099
Parameters Datum$
declare t%,m%,j%,rc%,h1&
if %PCount=0
Datum$=Date$(0)
endif
t%=day%(datum$)
m%=month%(datum$)
j%=year%(datum$)
if j%<100Jahresangabe 2stellig
j%=if(j%<Century%,j%+2000,j%+1900)
endif
j%=j%-1
h1&=(j%)*365
h1&=h1&+int((j%)/4)Schaltj
h1&=h1&-int(j%/100)kein Schaltj.
h1&=h1&+int(j%/400)Schaltj.
if (((j%+1) Mod 4)=0) and (m%>2)akt.Jahr=Schaltjahr
h1&=h1&+1
endif
case m%=1 : h1&=h1&+t%
case m%=2 : h1&=h1&+31+t%
case m%=3 : h1&=h1&+59+t%
case m%=4 : h1&=h1&+90+t%
case m%=5 : h1&=h1&+120+t%
case m%=6 : h1&=h1&+151+t%
case m%=7 : h1&=h1&+181+t%
case m%=8 : h1&=h1&+212+t%
case m%=9 : h1&=h1&+243+t%
case m%=10 : h1&=h1&+273+t%
case m%=11 : h1&=h1&+304+t%
case m%=12 : h1&=h1&+334+t%
rc%=(h1& Mod 7)
return rc%
EndProcDOW
Proc NToCDow$
-----------_
Wandelt eine Wochentagsnummer in einen Wochentagsnamen
Syntax NToCDow$ <nTagNummer>,<nDarstellung>
Parameter <nTagNummer> Wert wie in Prozedur DOW 0=So,1=Mo,...6=Sa
<nDarstellung> ist ein Parameter, wie die Darstellung des Wochentagsnamen
erfolgen soll. Ist <nDarstellung>=0, wird der Wochentag als Abkürzung Mo.,Di. ...
geliefert, ist <nDarstellung>=1, wird der volle Namen geliefert
1=Montag,Dienstag...
Rückgabe: der Name des Wochentages Mo. oder Montag ...
parameters tagNr%,wie%
declare rc$
if wie%=0
case tagnr%=0 : rc$="So."
case tagnr%=1 : rc$="Mo."
case tagnr%=2 : rc$="Di."
case tagnr%=3 : rc$="Mi."
case tagnr%=4 : rc$="Do."
case tagnr%=5 : rc$="Fr."
case tagnr%=6 : rc$="Sa."
else
case tagnr%=0 : rc$="Sonntag"
case tagnr%=1 : rc$="Montag"
case tagnr%=2 : rc$="Dienstag"
case tagnr%=3 : rc$="Mittwoch"
case tagnr%=4 : rc$="Donnerstag"
case tagnr%=5 : rc$="Freitag"
case tagnr%=6 : rc$="Sonnabend"
endif
return rc$
EndProcNtoCDow$
PROC LastDayOM
-------------
Ermittelt den letzten Tag eines Monats als Zahl
Syntax: LastDayOM [<cDatum>]
Parameter ein Datum [t]t.[m]m.[jj]jj; Vorgabe Systemdatum
Rückgabe: <nTageImMonat>
Datumsbereich 1901 - 2099
Parameters dat$
declare rc%,Monatstage$
Monatstage$="31,28,31,30,31,30,31,31,30,31,30,31"
if %PCount=0
dat$=Date$(0)
endif
rc%=val(SubStr$(Monatstage$,Month%(dat$),","))
case Isleap%(dat$) and (Month%(dat$)=2) : rc%=rc%+1
return rc%
EndProcLastDayOM
PROC NToCMonth$
--------------
Wandelt eine Monatsnummer in einen Monatsnamen
Syntax: NToCMonth$ <nMonat>
Parameter: <nMonat> ist eine Monatszahl, zu der ein Monatsname
geliefert wird. Ein fehlerhafter Parameter ergibt ""
Rückgabe: <cMonat> entspricht dem zu der angegebenen Monatszahl
<nMonat> korrespondierenden Monatsnamen
parameters mon%
declare rc$
if (mon%<1) or (mon%>12)
rc$=""
else
case mon%=1 : rc$="Januar"
case mon%=2 : rc$="Februar"
case mon%=3 : rc$="März"
case mon%=4 : rc$="April"
case mon%=5 : rc$="Mai"
case mon%=6 : rc$="Juni"
case mon%=7 : rc$="Juli"
case mon%=8 : rc$="August"
case mon%=9 : rc$="September"
case mon%=10 : rc$="Oktober"
case mon%=11 : rc$="November"
case mon%=12 : rc$="Dezember"
endif
return rc$
EndProcNToCMonth$
Proc AddMonth$
-------------
Monate zu einem Datum addieren bzw subtrahieren
Syntax: AddMonth$ <cDatum>,<nMonate> -> cDatumNeu
Parameter: <cDatum> ist das Datum (mit 4stelliger Jahreszahl),
zu dem <nMonate> Monate addiert/subtrahiert werden.
Ist <cDatum> ein Leerstring, wird das Systemdatum angenommen
Negative <nMonate> klammern: (-x)
Rückgabe: Das neue Datum "tt.mm.jjjj"
Parameters dat$,anz%
declare tag%,monat%,jahr%,z%,plusmon%,plusj%,rc$,lom%
if dat$=""
dat$=Date$(0)
endif
tag%=Day%(dat$)
monat%=Month%(dat$)
jahr%=Year%(dat$)
plusmon%=(abs(anz%) Mod 12)
plusj%=int(abs(anz%)/12)
if anz%<0
if (monat%-plusmon%)<1
inc plusj%
monat%=monat%-plusmon%+12
else
monat%=monat%-plusmon%
endif
jahr%=jahr%-plusj%
else
if (monat%+plusmon%)>12
inc plusj%
monat%=monat%+plusmon%-12
else
monat%=monat%+plusmon%
endif
jahr%=jahr%+plusj%
endif
rc$=format$("00",tag%)+"."+format$("00",monat%)+"."+format$("0000",jahr%)
LastDayOM rc$
if %(0)<tag%
tag%=%(0)
rc$=format$("00",tag%)+"."+format$("00",monat%)+"."+format$("0000",jahr%)
endif
Return rc$
EndProcAddMonth$
Proc ScanFTG
-----------
Prüft, ob das übergebene Datum ein Feiertag in a_FTG$ ist
Syntax ScanFTG <cDatum>
Parameter: <cDatum> ist ein Datum, zu dem geprüft werden soll,
ob es ein Feiertag ist
Rückgabe 1, wenn <cDatum> ein Feiertag ist, sonst 0
parameters dat$
declare z%,rc%
z%=2
rc%=0
While z% < (val(a_FTG$[1,1])+2)
if dat$=a_FTG$[z%,1]
rc%=1
z%=100
endif
inc z%
EndWhile
return rc%
EndProcScanFTG
Proc Feiertage
-------------
Ermittelt alle Feiertage
Benötigt Arrayvereinbarung a_FTG[x,2] [Datum,Name]
In a_FTG$[1,1]steht die Anzahl der eingetragenen Feiertage als ZK(!),
damit ist die Länge x des Array um 1 größer, als die Anzahl der
Feiertage.
In a_FTG$[n,1] steht das Datum, in a_FTG$[n,2] der Name
Parameters ostern$
ist das Osterdatum mit 4stelliger Jahreszahl!
==========
declare j%,j$,hilfdat$
j%=Year%(ostern$)
j$=str$(j%)
a_FTG$[2,1]="01.01."+j$
hilfdat$=ostern$
AddDay$ ostern$,(-2)
a_FTG$[3,1]=$(0)
a_FTG$[4,1]=ostern$
AddDay$ ostern$,1
a_FTG$[5,1]=$(0)
if j%>1932
a_FTG$[6,1]="01.05."+j$
else
a_FTG$[6,1]=""
endif
AddDay$ ostern$,39
a_FTG$[7,1]=$(0)
AddDay$ ostern$,49
a_FTG$[8,1]=$(0)
AddDay$ ostern$,50
a_FTG$[9,1]=$(0)
if j%<1990
a_FTG$[10,1]="17.06."+j$
else
a_FTG$[10,1]="03.10."+j$
endif
a_FTG$[13,1]="25.12."+j$
a_FTG$[14,1]="26.12."+j$
Bußtag nur bis 1994
if j%<1995
hilfdat$="24.12."+j$
DOW hilfdat$
AddDay$ hilfdat$,(-(%(0)+32))
a_FTG$[12,1]=$(0)
else
a_FTG$[12,1]=""
endif
a_FTG$[11,1]="31.10."+j$
EndProcFeiertage
Proc KontrolleDatum$
-------------------
kontrolliert die Plausibilität eines Datums
und setzt eine 2stellige Jahreszahl 4stellig
Syntax: KontrolleDatum$ <cDatum>
Parameter: <cDatum> ist das zu kontrollierende Datum
Datumsbereich bei 2stelliger Jahresangabe siehe bei Century%
Jahresangabe 1stellig und 3stellig nicht zulässig
Jahresangabe 1901 - 2099
Rückgabewert Datum OK, das Datum als tt.mm.jjjj
Datum fehlerhaft, ""
parameters Datum$
declare lg%,z1%,z2%,rc%,ZulZ$,lgZZ%,AnzP%,tag%,monat%,jahr%
declare Monatstage$,ultimo%,rc$
Monatstage$="31,28,31,30,31,30,31,31,30,31,30,31"
lg%=len(Datum$)
ZulZ$="0123456789."
lgZZ%=len(ZulZ$)
z1%=1
z2%=1
AnzP%=0
rc%=0
Zahlen und Punkt testen
WhileNot z1%>lg%
rc%=0
WhileNot z2%>lgZZ%
if Mid$(Datum$,z1%,1)=Mid$(ZulZ$,z2%,1)
rc%=1
z2%=lgZZ%
endif
inc z2%
EndWhile
if rc%=0
break
endif
inc z1%
z2%=1
EndWhile
Anzahl Punkte testen
if rc%=1
AnzP%=len(Datum$)-len(translate$(Datum$,".",""))
case AnzP%<>2 : rc%=0
endif
Monat testen
if rc%=1
if (Month%(Datum$)<1) or (Month%(Datum$)>12)
rc%=0
endif
endif
Jahr testen
case len(SubStr$(Datum$,3,"."))=1 : rc%=0
case len(SubStr$(Datum$,3,"."))=3 : rc%=0
if rc%=1
jahr%=Year%(Datum$)
if jahr%<100Jahresangabe 2stellig
jahr%=if(jahr%<Century%,jahr%+2000,jahr%+1900)
endif
if jahr%<1901
rc%=0
endif
endif
Tag des Monats testen
if rc%=1
if (jahr% Mod 4)=0
Monatstage$=Translate$(Monatstage$,"28","29")
endif
tag%=Day%(Datum$)
monat%=Month%(Datum$)
ultimo%=val(SubStr$(Monatstage$,monat%,","))
if (tag%<1) or (tag%>ultimo%)
rc%=0
endif
endif
if rc%=1
rc$=Format$("00",tag%)+"."+Format$("00",monat%)+"."+Format$("0000",jahr%)
else
rc$=""
endif
return rc$
EndProcKontrolleDatum$
Proc DOY
-------
Der Tag des Jahres zu einem Datum
Syntax: DOY [<cDatum>]
Parameter: <cDatum> ist das Datum, zu dem eine Tages-Seriennummer
ermittelt werden soll. Vorgabe Systemdatum
Rückgabe:<nTagImJahr> Die Zahl ist eine Tages-Seriennummer und gibt an,
der wievielte Tag in einem Jahr durch das Datum <cDatum> spezifiziert wird.
Beispiel: Berechnung des Abstandes zwischen heute und dem Beginn des Quartals,
in dem heute liegt.
doy
t1%=%(0)
boq$
doy $(0)
abstand%=t1%-%(0)
parameters dat$
declare rc%,SuTg$
if %PCount=0
dat$=date$(0)
endif
SuTg$="0,31,59,90,120,151,181,212,243,273,304,334"
if month%(dat$)>2
rc%=val(SubStr$(SuTg$,month%(dat$),","))+day%(dat$)+IsLeap%(dat$)
else
rc%=val(SubStr$(SuTg$,month%(dat$),","))+day%(dat$)
endif
return rc%
EndProcDOY
Proc BOQ$
--------
Das Datum für einen Quartalsbeginn ermitteln
Syntax: BOQ$ [<cDatum>] -> cDatumAnfangQuartal
Parameter: <cDatum> ist ein Datum, für das der erste Tag des Quartals
ermittelt wird, in dem dieses Datum liegt. Vorgabe Systemdatum
Rückgabe: cDatumAnfangQuartal
parameters dat$
declare rc$,monat%,monat$
if %PCount=0
dat$=date$(0)
endif
monat%=val(substr$(dat$,2,"."))
if monat%<4
monat$="01."
elseif monat%<7
monat$="04."
elseif monat%<10
monat$="07."
else
monat$="10."
endif
rc$="01."+monat$+substr$(dat$,3,".")
return rc$
EndProcBOQ$
Proc Quarter
------------
Ermittelt, in welchem Quartal ein Datum liegt
Syntax: Quarter [<cDatum>]
Parameter: <cDatum> ist ein Datum, für das ermittelt wird, in welchem
Quartal des Jahres es liegt. Vorgabe Systemdatum
Rückgabe: Die Nummer des Quartals
parameters dat$
declare rc%,monat%
if %PCount=0
dat$=date$(0)
endif
monat%=val(substr$(dat$,2,"."))
if monat%<4
rc%=1
elseif monat%<7
rc%=2
elseif monat%<10
rc%=3
else
rc%=4
endif
return rc%
EndProcQuarter
Proc CToDOW
----------
Wochentagsnamen in korespondierende Nummer umwandeln
Syntax: CToDOW <cWochentag>
Parameter: <cWochentag> ist eine Zeichenkette, die einen Wochentags-
namen enthält. Groß- und Kleinschreibung spielt keine Rolle.
Der Wochentagsname kann abgekürzt werden, diese Abkürzungen müssen
jedoch eindeutig sein. Liefert die Prozedur 9 zurück, wurde ein
ungültiger Name übergeben.
Rückgabe <nWochentag> 0=Sonntag, 1=Montag,...,6=Samstag/Sonnabend
parameters zk$
declare rc%,tage$,z%
rc%=0
tage$="SONNTAG/MONTAG/DIENSTAG/MITTWOCH/DONNERSTAG/FREITAG/SAMSTAG/SONNABEND"
z%=1
While z%<9
if Instr(Upper$(zk$),SubStr$(tage$,z%,"/"))=1
rc%=z%
break
endif
inc z%
EndWhile
if rc%=0Fehler
rc%=9
elseif rc%=8Sonnabend gefunden
rc%=6
else
dec rc%
endif
return rc%
EndProcCToDOW
Proc CToMonth
------------
Monatssnamen in korespondierende Nummer umwandeln
Syntax: CToMONTH <cMonat>
Parameter: <cMonat> ist eine Zeichenkette, die einen Monats-
namen enthält. Groß- und Kleinschreibung spielt keine Rolle.
Der Monatsname kann abgekürzt werden, diese Abkürzungen müssen
jedoch eindeutig sein. Liefert die Prozedur 0 zurück, wurde ein
ungültiger Name übergeben.
Rückgabe <nMonat> 1 - 12
parameters zk$
declare monat$,z%,rc%
monat$="JANUAR/FEBRUAR/MÄRZ/APRIL/MAI/JUNI/JULI/AUGUST/SEPTEMBER/
OKTOBER/NOVEMBER/DEZEMBER"
rc%=0
z%=1
While z%<13
if Instr(Upper$(zk$),SubStr$(monat$,z%,"/"))=1
rc%=z%
break
endif
inc z%
EndWhile
return rc%
EndProcCToMONTH
Proc DMY$
--------
Liefert ein Datum im Format tt. Monat jjjj
Syntax: DMY$ [<cDatum>]
Parameter: <cDatum> ist ein gültiges Datum, zu dem ein String erzeugt
werden soll. Vorgabe Systemdatum
Rückgabe: Die Zeichenkette "[t]t. Monat [jj]jj je nach Übergabeparameter
parameters dat$
declare monat$,rc$
monat$="Januar/Februar/März/April/Mai/Juni/Juli/August/September/
Oktober/November/Dezember"
if %PCount=0
dat$=date$(0)
endif
rc$=SubStr$(dat$,1,".")+". "+SubStr$(monat$,val(SubStr$(dat$,2,".")),"/")
+" "+SubStr$(dat$,3,".")
return rc$
EndProcDMY$
Proc Week
--------
Liefert die Wochennummer zu einem Datum
Syntax: Week [cDatum] -> nWocheImJahr
Parameter: <cDatum> ist ein Datum, für das ermittelt wird,
in der wievielten Woche des Jahres es liegt. Vorgabe Systemdatum
Rückgabe: nWocheImJahr
Gültigkeitsbereich 1901 bis 2099 !!!
Parameter dat$ mit 4stelliger Jahreszahl
DIN 1355
Der Montag ist der erste Tag der Woche.
Eine Woche gehört zu demjenigen Kalenderjahr, in dem 3 oder mehr Tage
der Woche liegen
Der Donnerstag einer Woche liegt immer in demjenigen Kalenderjahr, dem
die Woche zugerechnet wird.
Der 4. Januar liegt immer in der ersten KW.
Der 28. Dezember liegt immer in der letzten KW.
parameters dat$
declare wtgnr%,wtgnj%,sn%,neujahr$,jahr%
declare rc%ist die Kalenderwoche
if %PCount=0
dat$=date$(0)
endif
rc%=0
jahr%=year%(dat$)
if (jahr%>1900) and (jahr%<2100)
neujahr$=BOY$(dat$)
DOW neujahr$
wtgnj%=if(%(0)=0,7,%(0))Neuj.: So. wird WoTagnr. 7
DOY dat$
sn%=%(0)Seriennummer akt. Datum
DOW dat$
wtgnr%=if(%(0)=0,7,%(0))akt. Datum: So. wird WoTagnr. 7
Kein Schaltjahr
if (jahr% Mod 4) <> 0
if wtgnj%=1Jahr beginnt mit Mo.
rc%=int((sn%-wtgnj%)/7)+1
case sn%=365 : rc%=1
elseif wtgnj%=2Jahr beginnt mit Di.
if (sn% >= 364) or (sn%<7)
rc%=1
else
rc%=int((sn%-7)/7)+2
endif
elseif wtgnj%=3Jahr beginnt mit Mi.
if (sn% >= 363) or (sn%<6)
rc%=1
else
rc%=int((sn%-6)/7)+2
endif
elseif wtgnj%=4Jahr beginnt mit Do.
if sn%<5
rc%=1
else
rc%=int((sn%-5)/7)+2
endif
elseif wtgnj%=5Jahr beginnt mit Fr.
if sn%<4
rc%=53
else
rc%=int((sn%-4)/7)+1
endif
elseif wtgnj%=6Jahr beginnt mit Sa.
if sn%<3
rc%=if((jahr% Mod 4)=1,53,52)wenn Neujahr=Sa. UND Jahr von dat$
einem Schaltjahr folgt
else
rc%=int((sn%-3)/7)+1
endif
elseif wtgnj%=7Jahr beginnt mit So.
if sn%<2
rc%=52
else
rc%=int((sn%-2)/7)+1
endif
endif
elseSchaltjahr
if wtgnj%=1Jahr beginnt mit Mo.
rc%=int((sn%-wtgnj%)/7)+1
case sn% >= 365 : rc%=1
elseif wtgnj%=2Jahr beginnt mit Di.
if (sn% >= 364) or (sn%<7)
rc%=1
else
rc%=int((sn%-7)/7)+2
endif
elseif wtgnj%=3Jahr beginnt mit Mi.
if sn%<6
rc%=1
else
rc%=int((sn%-6)/7)+2
endif
elseif wtgnj%=4Jahr beginnt mit Do.
if sn%<5
rc%=1
else
rc%=int((sn%-5)/7)+2
endif
elseif wtgnj%=5Jahr beginnt mit Fr.
if sn%<4
rc%=53
else
rc%=int((sn%-4)/7)+1
endif
elseif wtgnj%=6Jahr beginnt mit Sa.
if sn%<3
rc%=52
else
rc%=int((sn%-3)/7)+1
endif
elseif wtgnj%=7Jahr beginnt mit So.
if sn%<2
rc%=52
elseif sn%=366
rc%=1
else
rc%=int((sn%-2)/7)+1
endif
endif
endif
endif
return rc%
EndProcwnr
Proc EOM$
--------
Das Datum für den letzten Tag eines Monats ermitteln
Syntax: EOM$ [<cDatum>]
Parameter: <cDatum> ist ein Datum, für das der letzte Tag des Monats
ermittelt wird, in dem es liegt. Vorgabe Systemdatum
Rückgabe: <cDatumEndeMonat> tt.[m]m.[jj]jj je nach Parameter
Gültigkeitsbereich <cDatum> 1901 - 2099
parameters dat$
declare rc$
if %PCount=0
dat$=date$(0)
endif
LastDayOM dat$
rc$=format$("00",%(0))+"."+SubStr$(dat$,2,".")+"."+SubStr$(dat$,3,".")
return rc$
EndProcEOM$
Proc EOQ$
--------
Das Datum für das Ende eines Quartals ermitteln
Syntax: EOQ$ [<cDatum>]
Parameter: <cDatum> ist ein Datum, für das der letzte Tag des Quartals
ermittelt wird, in dem es liegt. Vorgabe Systemdatum
Rückgabe: <cDatumEndeQuartal> tt.mm.[jj]jj je nach Parameter
parameters dat$
declare rc$,monat%,ende$
if %PCount=0
dat$=date$(0)
endif
monat%=val(substr$(dat$,2,"."))
if monat%<4
ende$="31.03."
elseif monat%<7
ende$="30.06."
elseif monat%<10
ende$="30.09."
else
ende$="31.12."
endif
rc$=ende$+substr$(dat$,3,".")
return rc$
EndProcEOQ$
Proc CDOW$
---------
Ermittelt den Wochentagsnamen eines Datums
Syntax: CDOW$ [<cDatum>]
Parameter: <cDatum> ist ein Datum, zu dem der Wochentagsnamen
ermittelt werden soll. Vorgabe Systemdatum
Rückgabe: <cWochentag>
parameters dat$
declare rc$,wtg$
wtg$="Sonntag,Montag,Dienstag,Mittwoch,Donnerstag,Freitag,Sonnabend"
if %PCount=0
dat$=date$(0)
endif
DOW dat$
rc$=SubStr$(wtg$,%(0)+1,",")
return rc$
EndProcCDOW$
Proc CMonth$
-----------
Ermittelt den Monatsnamen zu einem Datum
Syntax: CMonth$ [<cDatum>]
Parameter: <cDatum> ist ein Datum, zu dem der Monatsnamen
ermittelt werden soll. Vorgabe Systemdatum
Rückgabe: <cMonatsname>
parameters dat$
declare rc$,mon$
mon$="Januar,Februar,März,April,Mai,Juni,Juli,August,September,
Oktober,November,Dezember"
if %PCount=0
dat$=date$(0)
endif
rc$=SubStr$(mon$,Month%(dat$),",")
return rc$
EndProccMonth$
Print Week()
Waitinput
|
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ...  | 27.09.2008 ▲ |
| | |
|
Zum QuelltextThemeninformationenDieses Thema hat 2 subscriber: |
(766)
Deutsch
English
Français
Español
Italia