XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Datum-Eingabe prüfen
Lauffähig ab Profan-Version 6.6

PROC CHECKINPUT

    PARAMETERS DAT$
    Declare laenge%,zeichen$,zeichen%,Fehler%
    Ret$=
    let laenge%=len(dat$)

    if Neq(laenge%,10)

        case gt(laenge%,10):Ret$=Zuviele Zeichen!
        case lt(laenge%,10):Ret$=Zuwenig Zeichen!
        return 1 FEHLER

    ENDIF

    zeichen%=0
    Fehler%=0

    if gt  (val(mid$(gettext$(datum&),1,2)),31) wenn erste 2 Zeichen > 31

        Fehler%=1
        zeichen%=laenge% damit nicht erst die Schleife durchlaufen wird
        ret$=Tag ist größer 31!

    Endif

    if gt  (val(mid$(gettext$(datum&),4,2)),12) wenn Monatszeichen > 12

        Fehler%=1
        zeichen%=laenge% damit nicht erst die Schleife durchlaufen wird
        ret$=Monat ist größer 12!

    Endif

    Whilenot equ(zeichen%,laenge%)

        inc zeichen%
        let zeichen$=Mid$(dat$,zeichen%,1)

        if equ(zeichen%,3) Wenn 3tes Zeichen (muss . sein)

            if neq$(zeichen$,.)

                ret$=Drittes Zeichen muss ein Punkt sein
                Fehler%=1
                zeichen%=laenge% Damit Schleifenausstieg!

            endif

        elseif equ(zeichen%,6) Dito

            if neq$(zeichen$,.)

                ret$=Sechstes Zeichen muss ein Punkt sein
                Fehler%=1
                zeichen%=laenge% Damit Schleifenausstieg!

            endif

        else

            if equ$(zeichen$,0)

                let Fehler%=0

            elseif equ$(zeichen$,1)

                let Fehler%=0

            elseif equ$(zeichen$,2)

                let Fehler%=0

            elseif equ$(zeichen$,3)

                let Fehler%=0

            elseif equ$(zeichen$,4)

                let Fehler%=0

            elseif equ$(zeichen$,5)

                let Fehler%=0

            elseif equ$(zeichen$,6)

                let Fehler%=0

            elseif equ$(zeichen$,7)

                let Fehler%=0

            elseif equ$(zeichen$,8)

                let Fehler%=0

            elseif equ$(zeichen$,9)

                let Fehler%=0

            else

                ret$=Es wurde ein nichtnummerisches Zeichen gefunden
                Fehler%=1 Wenn unerlaubtes Zeichen
                zeichen%=laenge% Damit Schleifenausstieg!

            endif

        Endif

    Wend

    Case equ(Fehler%,1):Return 1
    RETURN 0 Wenn bis hierhin dann kein Fehler gefunden

ENDPROC

BEISPIELPROGRAMM:
Declare ende%,CHECKER&,DATUM$,Datum&
Declare ret$ Diese Variable um eine Fehlermeldung an eine Messagebox zu übergeben
Declare check% Diese Variable um Prozedurrückgabe abzufangen
WINDOWSTYLE 63
WindowTitle Datumeingabe überprüfen (c) Rolf Koch
WINDOW 100,100-350,110
CLS 0
USEFONT MS SANS SERIF,13,0,0,0,0
SETDIALOGFONT 1
let Datum$ = date$(0)
let datum& = @createEdit (%HWND,datum$,10,15,80,20)
let CHECKER& = @createButton(%HWND,Datum prüfen,10,45,150,20) Ist besser mit einem Schliessenbutton
ENDE%=0

WHILENOT ENDE%

    WAITINPUT

    If GetFocus(CHECKER&)

        let Datum$=GetText$(datum&)
        CHECKINPUT datum$
        CHECK%=@%(0) Rückgabe aus PROZEDUR (1=FEHLER)

        if equ(CHECK%,1)

            MessageBox(ret$,Eingabe überprüfen!,32) Ret$ wird oben definiert!
            let Datum$ = date$(0)
            settext datum&,datum$
            setfocus(datum&)

        Else

            TextColor RGB(255,255,0),0
            DRAWTEXT 100,16,
            TextColor RGB(255,255,0),0
            DRAWTEXT 100,16,Add$(Ergebnis Datum: ,datum$) Hier nur zur Demo!

        ENDIF

    ENDIF

WEND