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