XProfan

!
:Proc IsLeapYear( [Jahr%] )
: P:I1 - Jahr (1600 - 3999) (ohne Angabe wird das aktuelle Jahr benutzt)
:Proc IsLeapYear( DBDate$ )
: P:S1 - Datenbankdatum ("yyyymmdd")
:Proc IsLeapYear( sDatum# )
: P:B1 - ein Bereich mit Struktur "DatumStru"
:Proc IsLeapYear( bDatum# )
: P:B1 - ein Bereich ohne Struktur (der aber je 2 Bytes für Tag, Monat und Jahr enthält)
:Proc IsLeapYear( oMwDate# )
: P:o1 - ein Objekt der Klasse "MwDate"
: Prüft, ob das Jahr ein Schaltjahr war/ist.
:RETURN%: 1 = Jahr ist ein Schaltjahr, sonst 0

Proc IsLeapYear

    Declare y%

    If %PCount < 1              Parameter fehlen

        y% = Val(Date$(3))  10000   ziehe das Jahr aus dem akt. Datum im DB-Format.

    Else

        If PType$(1) = "&"       Parameter ist numerisch

            Parameters Jahr%
            y% = Jahr%

        ElseIf PType$(1) = "$"   Parameter ist ein String im Datenbankformat

            Parameters DBDate$
            y% = Val(DBDate$)  10000

        ElseIf PType$(1) = "s"   Parameter ist ein Bereich mit Struktur "DatumStru"

            Parameters sDatum#
            y% = sDatum#.Year%

        ElseIf PType$(1) = "b"   Parameter ist ein Bereich ohne Struktur

            Parameters bDatum#    (der aber je 2 Bytes für Tag, Monat und Jahr enthält)
            y% = Word(bDatum#,4)  0+1=Tag, 2+3=Monat, 4+5=Jahr

        ElseIf PType$(1) = "o"   Parameter ist ein Objekt der Klasse "MwDate"

            Parameters oDatum#
            y% = oDatum#.GetYear()
            Else                     Fehler! Liefert FALSE (kein Schaltjahr)
            Return 0

        EndIf

    EndIf

    Case y% < 100 : Add y%, ((Val(Date$(3))  1000000) * 100)
    Return (y% mod 4 = 0) and (y% mod 4000 <> 0) and ((y% mod 100 <> 0) or (y% mod 400 = 0))
    EndProc  IsLeapYear
    ### TEST ### TEST ### TEST ### TEST ### TEST ###
    Struct DatumStru = Day%,Month%,Year%
    Class MwDate = #Year%,SetYear@,GetYear@

    Proc MwDate.SetYear

        Parameters y%
        .Year% = y%

    EndProc

    Proc MwDate.GetYear

        Return .Year%

    EndProc

    Declare Jahr%, sBereich#, bBereich#, oMwDate#
    Dim sBereich#, DatumStru
    Dim bBereich#, 6
    Dim oMwDate#, MwDate
    Cls
    Print "eine Funktion mit variablen Parametern
    "
    Print "Schaltjahr??? (1 = Ja)
    "
    Print "aktuelles Jahr (nein):", IsLeapYear(), " - ohne Parameter"
    Print "1600 (Ja)............:", IsLeapYear(1600), " - Zahl als Parameter"
    Print "1999 (Nein)..........:", IsLeapYear("19990101"), " - Datum im Datenbankformat"
    sBereich#.Year% = 2004
    Print "2004 (Ja)............:", IsLeapYear(sBereich#), " - strukturierter Bereich"
    Word bBereich#,4 = 2005
    Print "2005 (Nein)..........:", IsLeapYear(bBereich#), " - Bereich ohne Struktur"
    oMwDate#.SetYear( 2006 )
    Print "2006 (Nein)..........:", IsLeapYear(oMwDate#), " - Objekt als Parameter"
    Print "
    zur Probe alle mit dem Jahr 2004 (Na gut, OHNE den Parameter-freien):"
    Word bBereich#,4 = 2004
    oMwDate#.SetYear( 2004 )
    Print "2004 (Ja)............:", IsLeapYear(2004), " - Zahl als Parameter"
    Print "2004 (Ja)............:", IsLeapYear("20040101"), " - Datum im Datenbankformat"
    Print "2004 (Ja)............:", IsLeapYear(sBereich#), " - strukturierter Bereich"
    Print "2004 (Ja)............:", IsLeapYear(bBereich#), " - Bereich ohne Struktur"
    Print "2004 (Ja)............:", IsLeapYear(oMwDate#), " - Objekt als Parameter"
    Print "
    (Taste drücken = ENDE)"
    Print "
    %PCount und PType$() in Kombination sind wirklich eine feine Sache ..."
    WaitKey
    Dispose sBereich#
    Dispose bBereich#
    Dispose oMwDate#
    End