XProfan

Def GetSysColor(1) !"USER32","GetSysColor"
cls GetSysColor(15)
UseFont "Arial",15,0,0,0,0
SETDIALOGFONT 1
CreateText(%hwnd,"num. Eingabe max.: nn.nn",30,120,200,22)
var Ed&=Create("Edit",%hwnd,"",30,165,80,20)
@sendmessage(Ed&,$00C5,5,0)'und auf 5 Stellen (nn.nn) begrenzt
SetFocus(Ed&)

While 1

    WaitInput
    case %key=2 : BREAK
    case GETFOCUS(Ed&): NUMWERT Ed&,2'Handle, Zeichen vorm Komma

EndWhile

End

Proc NUMWERT' AUSWERTUNG auf Zeichen und Stellen

    Parameters ED.N&,ED.N%
    var a$="abcdefghijklmnopqrstuvwxyz"
    a$=a$+Upper$("abcdefghijklmnopqrstuvwxyz")
    a$=a$+"!§$%&/()=?''*':;,-_²³{[]}\^°<>|++-"
    var c$=""

    WhileLoop len(a$)

        c$ = MID$(a$,&Loop,1)' c$= der nte Stringteil
        Settext ED.N&,@Translate$(gettext$(ED.N&),c$,"")' unzulässige löschen
        Settext ED.N&,@Translate$(gettext$(ED.N&),"..",".")' doppelte löschen

    EndWhile

    a$=trim$(gettext$(ED.N&))

    WhileLoop ED.N%+1

        @Match$("~.", a$)

        If (%MatchPos>0) AND (%MatchPos<ED.N%+1)

            a$="0"+a$

        EndIf

    EndWhile

    If len(a$)=ED.N%

        casenot @IsKey(8):a$=left$(a$,ED.N%)+"."

    EndIf

    SetText ED.N&,a$
    sendmessage(ED.N&,$00B1,len(gettext$(ED.N&)),len(gettext$(ED.N&))+1)'Cursor ans Ende
    SetFocus(ED.N&)

EndProc

var erlaubteZeichen$="abcdefghijklmnopqrstuvwxyz"+Upper$("abcdefghijklmnopqrstuvwxyz")+"!§$%&/()=?''*':;,-_²³{[]}\\^°<>|++-"
Def GetSysColor(1) !"USER32","GetSysColor"
cls GetSysColor(15)
UseFont "Arial",15,0,0,0,0
SETDIALOGFONT 1
var nix&=CreateText(%hwnd,"num. Eingabe max.: nn.nn",30,120,200,22)
var Ed&=Create("Edit",%hwnd,"",30,165,80,20)
SetFocus(Ed&)
subclass ed&,1//true

While 1

    WaitInput
    case %key=2 : BREAK

EndWhile

End

subClassProc

    if &sWnd=ed&

        if %sMessage=258//wm_char

            var p&=hiWord(sendMessage(ed&,$B0,0,0))//em_getSel
            var s$=getText$(ed&)
            var ch$=chr$(&swParam)

            ifnot instr(ch$,erlaubteZeichen$)

                if &swParam=8

                    if p&

                        if p&=3

                            s$=del$(s$,p&,1)
                            dec p&,1

                        endif

                        s$=del$(s$,p&,1)
                        dec p&,1

                    endif

                endif

                s$=translate$(s$,".","")
                case len(s$)>1 : s$=ins$(".",s$,3)
                setText ed&,s$
                sendMessage(ed&,$B1,p&,p&)//em_setSel

            else

                s$=ins$(ch$,s$,p&+1)
                s$=translate$(s$,".","")
                case len(s$)>1 : s$=ins$(".",s$,3)
                s$=mid$(s$,1,5)
                setText ed&,s$
                case p&=1 : add p&,1
                sendMessage(ed&,$B1,p&+1,p&+1)//em_setSel

            endif

            set("winproc",0)

        endif

    endif

endProc