XProfan

DEF DToN(1)  !"PRFDAT32.DLL","DToN"
DEF NToD(1)  !"PRFDAT32.DLL","NToD"
DEF DOW(1)   !"PRFDAT32.DLL","DOW"
class Date =  #Date$(32),
#Year%,
#Month%,
#Day%,
#DayOfWeek%,
-DateDLL&,
-DateEdit&,
-DateInt&,
-Form$(30),
Init@,
GetDate@,
GetYear@,
GetMonth@,
GetDay@,
GetDayOfWeek@,
SetDate@,
SetFormat@,
SetYear@,
SetMonth@,
SetDay@,
AddDays@,
DiffDays@,
CreateEdit@,
KillEdit@,
-konvD@,
-SetDateEdit@

PROC Date.setDateEdit

    declare daten#

    If .DateEdit& > 0

        dim daten#,20
        SendMessage(.DateEdit&,4097,0,daten#)
        Word Daten#,0=.Year%
        Word Daten#,2=.Month%
        Word Daten#,6=.Day%
        SendMessage(.DateEdit&,4098,0,daten#)

    EndIf

    dispose daten#

ENDPROC

PROC Date.konvD

    parameters d$

    If .DateDLL& > 31

        .DateInt& = DToN(Val(d$))

    Else

        .DateInt& = 0

    EndIf

    .Year% = Val(Mid$(d$,1,4))
    .Month% = Val(Mid$(d$,5,2))
    .Day% = Val(Mid$(d$,7,2))
    .setDateEdit()

Endif

ENDPROC

PROC Date.Init

declare d$
d$ = Date$(3)
.DateDLL& = UseDll("PRFDAT32.DLL")
.Date$ = Date$(0)
.konvD(d$)
.Form$ = "dd.mm.yyyy"

ENDPROC

PROC Date.setDate

declare OK%
OK% = 1

if %pcount = 1

    parameters in$
    declare d$, err%
    err% = set("ErrorLevel",-1)
    d$ = CToD$(in$)

    if %error

        .Date$ = ""
        .Year% = 0
        .Month% = 0
        .Day% = 0
        OK% = 0  Fehler

    else

        .Date$ = ins$
        .konvD(d$)

    endif

    set("ErrorLevel",err%)

elseif %pcount = 3

    parameters y%,m%,d%

    if (y% >= 1600) and (y% < 4000)

        .Year% = y%

    else

        OK% = 0

    endif

    if (m% > 0) and (m% < 13)

        .Month% = m%

    else

        OK% = 0

    endif

    if (d% > 0) and (d% < 32)

        .Day% = d%

    else

        OK% = 0

    endif

    if Ok%

        .Date$ = format$("00",d%) + "." + format$("00",m%) + format$("0000",y%)

    endif

else

    OK% = 0

endif

return OK%

ENDPROC

PROC Date.getDate

if %pcount > 0

    parameters f$

else

    declare f$
    f$ = trim$(.Form$)

endif

f$ = translate$(f$,"yyyy",Str$(.Year%))
f$ = translate$(f$,"yy",Format$("00",Str$(.Year% MOD 100)))
f$ = translate$(f$,"mm",Format$("00",Str$(.Month%)))
f$ = translate$(f$,"m",Str$(.Month%))
f$ = translate$(f$,"dd",Format$("00",Str$(.Day%)))
f$ = translate$(f$,"d",Str$(.Day%))
return f$

ENDPROC

PROC Date.setYear

parameters y%

if (y% >= 1600) and (y% < 4000)

    .Year% = y%
    .Date$ = format$("00",.Day%) + "." + format$("00",.Month%) + format$("0000",.Year%)
    return 1

else

    return 0

endif

ENDPROC

PROC Date.setMonth

parameters m%

if (m% > 0) and (m% < 13)

    .Month% = m%
    .Date$ = format$("00",.Day%) + "." + format$("00",.Month%) + format$("0000",.Year%)
    return 1

else

    return 0

endif

ENDPROC

PROC Date.setDay

parameters d%

if (d% > 0) and (d% < 32)

    .Day% = d%
    .Date$ = format$("00",.Day%) + "." + format$("00",.Month%) + format$("0000",.Year%)
    return 1

else

    return 0

endif

ENDPROC

PROC Date.setFormat

parameters f$
.Form$ = f$

ENDPROC

PROC Date.getYear

return .Year%

ENDPROC

PROC Date.getMonth

return .Month%

ENDPROC

PROC Date.getDay

return .Day%

ENDPROC

PROC Date.getDayOfWeek

declare n&

if .DateDLL& > 32

    n& = DTON(val(.getDate("yyyymmdd")))
    return DOW(n&)

else

    return 0

endif

ENDPROC

PROC Date.AddDays

parameters days%
declare d&, n&

if .DateDLL& > 32

    d& = val(.getDate("yyyymmdd"))
    n& = DTON(d&) + days%
    d& = NTOD(n&)
    .setDay(d& mod 100)
    .setMonth((d&  100) mod 100)
    .setYear(d&  10000)
    .setDate(.Year%,.Month%,.Day%)
    return 1

else

    return 0

endif

ENDPROC

PROC Date.DiffDays

parameters d2#
declare n2&,n1&

if .DateDLL& > 32

    n1& = DTON(val(.getDate("yyyymmdd")))
    n2& = DTON(val(d2#.getDate("yyyymmdd")))
    return int(n2& - n1&)

else

    return 0

endif

ENDPROC

PROC Date.createEdit

parameters hdlg&, x&, y&, dx&, dy&
.DateEdit& = Create("DateEdit", hdlg&, "", x&, y&, dx&, dy&)
.setDateEdit()
return .DateEdit&

ENDPROC

PROC Date.killEdit

return DestroyWindow(.DateEdit&)

ENDPROC