XProfan

var ue$="   Normwert-Ermittlung":Windowtitle ue$
'(CL) CopyLeft 2016-12 by P.Pájaro carpintero, Wien/AT sin jede Gewähr!
Windowstyle 24:Cls:Font 2:set("decimals",17)
Declarar E$[6],E&,EE&,z$[],R!,R$ , W!,abw!,dz&
'{ Normwertreihen }
E$[0]="E3,1.00,2.20,4.70,10.0":E$[1]="E6,1.00,1.50,2.20,3.30,4.70,6.80,10.0"
E$[2]="E12,1.00,1.20,1.50,1.80,2.20,2.70,3.30,3.90,4.70,5.60,6.80,8.20,10.0"
E$[3]="E24,1.00,1.10,1.20,1.30,1.50,1.60,1.80,2.00,2.20,2.40,2.70,3.00,3.30,"+\
"3.60,3.90,4.30,4.70,5.10,5.60,6.20,6.80,7.50,8.20,9.10,10.0"
E$[4]="E48,1.00,1.05,1.10,1.15,1.21,1.27,1.33,1.40,1.47,1.54,1.62,1.69,1.78,1.87,1.96,2.05,2.15,"+\
"2.26,2.37,2.49,2.61,2.74,2.87,3.01,3.16,3.32,3.48,3.65,3.83,4.02,4.22,4.42,4.64,4.87,5.11,5.36,"+\
"5.62,5.90,6.19,6.49,6.81,7.15,7.50,7.87,8.25,8.66,9.09,9.53,10.0"
E$[5]="E96,1.00,1.02,1.05,1.07,1.10,1.13,1.15,1.18,1.21,1.24,1.27,1.30,1.33,1.37,1.40,1.43,1.47,"+\
"1.50,1.54,1.58,1.62,1.65,1.69,1.74,1.78,1.82,1.87,1.91,1.96,2.00,2.05,2.10,2.15,2.21,2.26,2.32,"+\
"2.37,2.43,2.49,2.55,2.61,2.67,2.74,2.80,2.87,2.94,3.01,3.09,3.16,3.24,3.32,3.40,3.48,3.57,3.65,"+\
"3.74,3.83,3.92,4.02,4.12,4.22,4.32,4.42,4.53,4.64,4.75,4.87,4.99,5.11,5.23,5.36,5.49,5.62,5.76,"+\
"5.90,6.04,6.19,6.34,6.49,6.65,6.81,6.98,7.15,7.32,7.50,7.68,7.87,8.06,8.25,8.45,8.66,8.87,9.09,"+\
"9.31,9.53,9.76,10.0"
E$[6]="E192,1.00,1.01,1.02,1.04,1.05,1.06,1.07,1.09,1.10,1.11,1.13,1.14,1.15,1.17,1.18,1.20,1.21,"+\
"1.23,1.24,1.26,1.27,1.29,1.30,1.32,1.33,1.35,1.37,1.38,1.40,1.42,1.43,1.45,1.47,1.49,1.50,1.52,"+\
"1.54,1.56,1.58,1.60,1.62,1.64,1.65,1.67,1.69,1.72,1.74,1.76,1.78,1.80,1.82,1.84,1.87,1.89,1.91,"+\
"1.93,1.96,1.98,2.00,2.03,2.05,2.08,2.10,2.13,2.15,2.18,2.21,2.23,2.26,2.29,2.32,2.34,2.37,2.40,"+\
"2.43,2.46,2.49,2.52,2.55,2.58,2.61,2.64,2.67,2.71,2.74,2.77,2.80,2.84,2.87,2.91,2.94,2.98,3.01,"+\
"3.05,3.09,3.12,3.16,3.20,3.24,3.28,3.32,3.36,3.40,3.44,3.48,3.52,3.57,3.61,3.65,3.70,3.74,3.79,"+\
"3.83,3.88,3.92,3.97,4.02,4.07,4.12,4.17,4.22,4.27,4.32,4.37,4.42,4.48,4.53,4.59,4.64,4.70,4.75,"+\
"4.81,4.87,4.93,4.99,5.05,5.11,5.17,5.23,5.30,5.36,5.42,5.49,5.56,5.62,5.69,5.76,5.83,5.90,5.97,"+\
"6.04,6.12,6.19,6.26,6.34,6.42,6.49,6.57,6.65,6.73,6.81,6.90,6.98,7.06,7.15,7.23,7.32,7.41,7.50,"+\
"7.59,7.68,7.77,7.87,7.96,8.06,8.16,8.25,8.35,8.45,8.56,8.66,8.76,8.87,8.98,9.09,9.20,9.31,9.42,"+\
"9.53,9.65,9.76,9.88,10.0"
'}
loep:
cls:Imprimir "\n  Welche ISO E-Reihe? [0=E3 1=E6 2=E12 3=E24 4=E48 5=E96 6=E192] Nr.= ";
input r$:E&=val(translate$(r$,",",".")):caso r$="":E&=6:caso (E&<0) or (E&>6):goto "loep"
z$[]=Explode(E$[E&],","):ee&=SizeOf(z$[])+1:Claro z$[]
Imprimir "\n  Werteanzahl en Reihe Nr.";E&;":  E=";int(ee&-3);"\n"
Windowtitle ue$+"   para el ISO-Normwerte-Reihe E"+str$(int(EE&-3))

Repeat

    Imprimir "\n  Valor = ";:Entrada R$:R!=Val(Abs(Translate$(R$,",","."))):caso r!<0:goto "loep"
    W!=EREIHE(E&,EE&,R!):if w!<0:Imprimir "\n  Overflow!":continue:endif
    locate %csrlin-1,21:Imprimir "Nähest.Normwert = ";format$("%g",W!),

    if r!<>0:abw!=(w!-r!)/r!*100 :más:abw!=0:endif

        dz&=get("decimals"):set("decimals",2):Imprimir tab(52);"Rel.Abweichung ";if(abw!<0,""," ");abw!;" %"
        set("decimals",dz&)

        if %csrlin>28:imprimir "\n  _________________":waitinput:cls:endif

        Until 0

        Proc EREIHE :Parámetros E&,EE&,R!

            Declarar R$,v&,ex&,o!,u!
            R$=E$[E&]
            lup:
            :if R!>=10:inc ex&:R!=R!/10:goto "lup":endif
            :if (R!<1) and not(R!=0):dec ex&:R!=R!*10:goto "lup":endif

            WhileLoop 1,EE&,1:v&=&Loop

                U!=O!:O!=Val(Substr$(R$,v&,",")):Case (O!>=R!):BREAK
                EndWhile:Case v&=EE&:Volver -1
                Volver If(Abs(R!-O!)<=Abs(R!-U!),O!*10^ex&,U!*10^ex&)

            ENDPROC