ALGORITHMEN TEIL XI: Genaue Planung ersetzt Zufall durch Irrtum

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    • Debug des vorherigen Beitrages scheint erfolgreich. Beta0.2, bitte ausführlich testen:

      Quellcode

      1. WindowTitle " P.Specht´s U I P R Einphasen-Kreuz-& Quer-Rechner"
      2. ' (D) Demo by P.Specht, Vienna/Austria. NO WARRANTY WHATSOEVER!
      3. WindowStyle 24:font 2:set("decimals",17):Window 200,100 - 400,175
      4. Declare U!,I!,P!,R!, u$,i$,p$,r$ , l1$,l2$,l3$
      5. font 2:print "\n Dieser Rechner verknüpft die vier Größen "
      6. print " Spannung, Strom, Leistung und Widerstand. "
      7. font 0:print " Die letzten beiden Eingaben stellen die "
      8. print " jeweils vorgegebenen Größen dar. Die an-"
      9. print " deren beiden Werte werden errechnet und "
      10. font 2:print " sind in fetter Schrift dargestellt."
      11. font 0:print " RETURN springt von Feld zu Feld. Ohne Einga-"
      12. print " bewerte (zB: 1e-6) wird nichts verändert,"
      13. print " sondern nur weitergesprungen! ";
      14. font 2:print " [Start]";:waitinput
      15. Repeat:Cls:Print "Geg.:"
      16. if (l1$="U") or (l2$="U"):font 0:else:font 2:endif
      17. locate 3,1 :Print l1$;l2$;" Spannung U [Volt V] = ";
      18. locate 3,26:Print format$("%g",U!);
      19. if (l1$="I") or (l2$="I"):font 0:else:font 2:endif
      20. locate 5,1 :Print l1$;l2$;" Strom I [Ampere A] = ";
      21. locate 5,26:Print format$("%g",I!);
      22. if (l1$="P") or (l2$="P"):font 0:else:font 2:endif
      23. locate 7,1 :Print l1$;l2$;" Leistung P [Watt W] = ";
      24. locate 7,26:Print format$("%g",P!);
      25. if (l1$="R") or (l2$="R"):font 0:else:font 2:endif
      26. locate 9,1 :Print l1$;l2$;" Widerstand R [Ohm] = ";
      27. locate 9,26:Print format$("%g",R!);
      28. locate 3,26:input u$:if u$>"":U!=val(u$):l3$=l2$:l2$=l1$:l1$="U":goto "calc":endif
      29. locate 5,26:input i$:if i$>"":I!=val(i$):l3$=l2$:l2$=l1$:l1$="I":goto "calc":endif
      30. locate 7,26:input p$:if p$>"":P!=val(p$):l3$=l2$:l2$=l1$:l1$="P":goto "calc":endif
      31. locate 9,26:input r$:if r$>"":R!=abs(val(r$)):l3$=l2$:l2$=l1$:l1$="R":goto "calc":endif
      32. calc:
      33. if l1$="U"
      34. if l2$="U":l2$=l3$:l3$="" :goto "calc"
      35. elseif l2$="I":P!=U!*I!:case i!=0:i!=val("1e-50"):R!=abs(U!/I!)
      36. elseif l2$="P":case u!=0:u!=val("1e-50"):I!=P!/U!:case P!=0:P!=val("1e-50"):R!=abs(sqr(U!)/P!)
      37. elseif l2$="R":case r!=0:r!=val("1e-50"):I!=U!/R!:P!=sqr(U!)/R!
      38. endif
      39. elseif l1$="I"
      40. if l2$="U":P!=U!*I!:case i!=0:i!=val("1e-50"):R!=abs(U!/I!)
      41. elseif l2$="I":l2$=l3$:l3$="" :goto "calc"
      42. elseif l2$="P":case i!=0:i!=val("1e-50"):U!=P!/I!:R!=abs(P!/sqr(I!))
      43. elseif l2$="R":U!=I!*R!:P!=sqr(I!)*R!
      44. endif
      45. elseif l1$="P"
      46. if l2$="U":case u!=0:u!=val("1e-50"):I!=P!/U!:case P!=0:P!=val("1e-50"):R!=abs(sqr(U!)/P!)
      47. elseif l2$="I":case i!=0:i!=val("1e-50"):U!=P!/I!:R!=abs(P!/sqr(I!))
      48. elseif l2$="P":l2$=l3$:l3$="" :goto "calc"
      49. elseif l2$="R":U!=sqrt(abs(P!*R!)):case R!=0:R!=val("1e-50"):I!=sqrt(abs(P!/R!))
      50. endif
      51. elseif l1$="R"
      52. if l2$="U":case r!=0:r!=val("1e-50"):I!=U!/R!:P!=sqr(U!)/R!
      53. elseif l2$="I":U!=I!*R!:P!=sqr(I!)*R!
      54. elseif l2$="P":U!=sqrt(abs(P!*R!)):case R!=0:R!=val("1e-50"):I!=sqrt(abs(P!/R!))
      55. elseif l2$="R":l2$=l3$:l3$="" :goto "calc"
      56. endif
      57. endif
      58. until 0
      Alles anzeigen

      Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von p. specht ()

    • Abt. Widerstandsfarbcode
      ===================
      Als Vorstudie zu einer Farbcode-Ermittlung für elektronische Kohleschicht-Widerstände (3-Ring-System) und Metallfilm-Widerstände (4-Ring-System, also nicht SMD): Hier ein erstes Zwischenergebnis. Es mutet erstaunlich an, daß die beim Print-Befehl verwendeten alten DOS-Farben NICHT die bei Bastlern damals sehr bekannten Farbcodes abdecken! Deshalb mußten einige Farben umgetitelt werden, und das fehlende Orange wurde duch Lila (+ Hinweis) ersetzt.
      [EDIT]: Dank an Volkmar für seinen Fehlerhinweis. Korrigiert!
      Gruss

      P.S.: Mir klar, daß mit heutigen Analogfarben unter Verwendung von DrawText statt Print bessere Ergebnisse möglich sind. Es ging ja auch nur um einen ersten Versuch ...

      Quellcode

      1. Windowtitle mkstr$(" ",14)+upper$(sperr$("Farbcode von Widerständen"))+" Taste ´T´= 3\4 Ringe"
      2. ' (CL) CopyLeft 2016-12 by P.Specht, Wien/AT ohne jede Gewähr! Farben sehr systemabhängig !!
      3. Cls $A0A0A0
      4. AppendMenuBar 100,"Im Farbcode wurde Orange durch Lila ersetzt, um die DOS-Printfarben verwenden zu können!"
      5. :proc sperr$ :parameters u$:whileloop len(u$),2,-1:u$=ins$(" ",u$,&Loop):endwhile:return u$:endproc
      6. declare ko&,Farbbez$,Kurzbez$,BgColor$,TxtColor$,Mul$,Prec$
      7. Farbbez$="Silber ,Gold ,Schwarz,Braun ,Rot ,Lila=Orange,Gelb ,Grün ,Blau ,"+\
      8. "Violett,Grau ,Weiss ,Dunkelgrün,Dunkelblau,Cyan ,Türkis "
      9. Kurzbez$=" Sb,Gld, Sw, Bn, Rt, Or, Gb, Gn, Bl, Vt, Gr, Ws,dGn,dBl,Cyn, Tk"
      10. BgColor$=" 7, 6 , 0, 4, 12, 11, 14, 10, 9, 3, 8, 15, 2, 1, 5, 13"
      11. Txtcolor$=" 0, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 0, 15, 15, 15, 0"
      12. Mul$="0.1 ,0.01,1 ,10 ,100 ,1 k,10 k,100k,1 M,10 M,,,,,,,"
      13. Prec$=" 5 %=J,10 %=K,, 1 %=F, 2 %=G,,,0.5 %=D,0.25%=C,0.1 %=B,0.05% ,,,,,,"
      14. luuup:
      15. Cls $A0A0A0:Font 2-2*ko&
      16. whileloop 16
      17. color val(substr$(Txtcolor$,&Loop,",")),val(substr$(BgColor$,&Loop,","))
      18. locate 2*&Loop,5 :print " "+substr$(Farbbez$,&Loop,",")+" ";
      19. locate 2*&Loop,19:print " "+substr$(Kurzbez$,&Loop,",")+" ";
      20. if &Loop=12:line 0,320 - width(%hwnd),320:line 210,0 - 210,width(%hwnd):endif
      21. if &Loop<13
      22. if &Loop > 2
      23. locate 2*&Loop,31:print " "+if(&loop>12,""," ")+str$(int(&Loop-3))+" ";
      24. locate 2*&Loop,38:print " "+if(&loop>12,""," ")+str$(int(&Loop-3))+" ";
      25. if ko&:locate 2*&Loop,45:print " "+if(&loop>12,""," ")+str$(int(&Loop-3))+" ";:endif
      26. endif
      27. if &Loop<11
      28. locate 2*&Loop,45+7*ko&
      29. print "x "+if(ko&,format$("%g",10^(&Loop-3)),substr$(Mul$,&Loop,","))+" ";
      30. endif
      31. locate 2*&Loop,67:print if(substr$(Prec$,&Loop,",")>""," +/-","")+substr$(Prec$,&Loop,",");
      32. endif
      33. endwhile
      34. Waitinput
      35. case %key=ord("t"):ko&=not(ko&)
      36. goto "luuup"
      Alles anzeigen

      Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von Volkmar () aus folgendem Grund: Fehler auf Wunsch TE korrigiert

    • Abt. Näheste Normwerte gemäß ISO-E-Reihen ermitteln
      ===================================
      Eine Berechnung ergäbe z.B. einen erforderlichen Vorwiderstand von 375 Ohm. In der eingekaufen Normwertreihe ist 383 Ohm der nächstkommende Wert. Die dadurch gegebene relative Abweichung wirkt sich auf erforderliche Ströme (Einstellung von Arbeitspunkten), Spannungen und z.B. auf Verlustleistungen aus und ist daher auf Zulässigkeit nachzurechnen. Es bleibt also noch einiges an Handarbeit über...
      Gruss

      Quellcode

      1. var ue$=" Normwert-Ermittlung":Windowtitle ue$
      2. '(CL) CopyLeft 2016-12 by P.Specht, Wien/AT ohne jede Gewähr!
      3. Windowstyle 24:Cls:Font 2:set("decimals",17)
      4. Declare E$[6],E&,EE&,z$[],R!,R$ , W!,abw!,dz&
      5. '{ Normwertreihen }
      6. 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"
      7. 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"
      8. 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,"+\
      9. "3.60,3.90,4.30,4.70,5.10,5.60,6.20,6.80,7.50,8.20,9.10,10.0"
      10. 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,"+\
      11. "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,"+\
      12. "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"
      13. 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,"+\
      14. "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,"+\
      15. "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,"+\
      16. "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,"+\
      17. "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,"+\
      18. "9.31,9.53,9.76,10.0"
      19. 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,"+\
      20. "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,"+\
      21. "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,"+\
      22. "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,"+\
      23. "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,"+\
      24. "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,"+\
      25. "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,"+\
      26. "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,"+\
      27. "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,"+\
      28. "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,"+\
      29. "9.53,9.65,9.76,9.88,10.0"
      30. '}
      31. loep:
      32. cls:Print "\n Welche ISO E-Reihe? [0=E3 1=E6 2=E12 3=E24 4=E48 5=E96 6=E192] Nr.= ";
      33. input r$:E&=val(translate$(r$,",",".")):case r$="":E&=6:case (E&<0) or (E&>6):goto "loep"
      34. z$[]=Explode(E$[E&],","):ee&=SizeOf(z$[])+1:Clear z$[]
      35. Print "\n Werteanzahl in Reihe Nr.";E&;": E=";int(ee&-3);"\n"
      36. Windowtitle ue$+" für die ISO-Normwerte-Reihe E"+str$(int(EE&-3))
      37. Repeat
      38. Print "\n Wert = ";:Input R$:R!=Val(Abs(Translate$(R$,",","."))):case r!<0:goto "loep"
      39. W!=EREIHE(E&,EE&,R!):if w!<0:Print "\n Overflow!":continue:endif
      40. locate %csrlin-1,21:Print "Nähest.Normwert = ";format$("%g",W!),
      41. if r!<>0:abw!=(w!-r!)/r!*100 :else:abw!=0:endif
      42. dz&=get("decimals"):set("decimals",2):Print tab(52);"Rel.Abweichung ";if(abw!<0,""," ");abw!;" %"
      43. set("decimals",dz&)
      44. if %csrlin>28:print "\n _________________":waitinput:cls:endif
      45. Until 0
      46. Proc EREIHE :Parameters E&,EE&,R!
      47. Declare R$,v&,ex&,o!,u!
      48. R$=E$[E&]
      49. lup:
      50. :if R!>=10:inc ex&:R!=R!/10:goto "lup":endif
      51. :if (R!<1) and not(R!=0):dec ex&:R!=R!*10:goto "lup":endif
      52. WhileLoop 1,EE&,1:v&=&Loop
      53. U!=O!:O!=Val(SubStr$(R$,v&,",")):Case (O!>=R!):BREAK
      54. EndWhile:Case v&=EE&:Return -1
      55. Return If(Abs(R!-O!)<=Abs(R!-U!),O!*10^ex&,U!*10^ex&)
      56. EndProc
      Alles anzeigen
    • Kann das sein, daß in #42 die Farben für ersten 2/3 Ringe nicht passen? Ich kenne das eigentlich so:


      Quellcode

      1. Windowtitle mkstr$(" ",14)+upper$(sperr$("Farbcode von Widerständen"))+" Taste ´T´= 3\4 Ringe"
      2. ' (CL) CopyLeft 2016-12 by P.Specht, Wien/AT ohne jede Gewähr! Farben sehr systemabhängig !!
      3. ' Farben für die ersten 2/3 Ringe geändert VG
      4. Cls $A0A0A0
      5. AppendMenuBar 100,"Im Farbcode wurde Orange durch Lila ersetzt, um die DOS-Printfarben verwenden zu können!"
      6. :proc sperr$ :parameters u$:whileloop len(u$),2,-1:u$=ins$(" ",u$,&Loop):endwhile:return u$:endproc
      7. declare ko&,Farbbez$,Kurzbez$,BgColor$,TxtColor$,Mul$,Prec$
      8. Farbbez$="Silber ,Gold ,Schwarz,Braun ,Rot ,Lila=Orange,Gelb ,Grün ,Blau ,"+\
      9. "Violett,Grau ,Weiss ,Dunkelgrün,Dunkelblau,Cyan ,Türkis "
      10. Kurzbez$=" Sb,Gld, Sw, Bn, Rt, Or, Gb, Gn, Bl, Vt, Gr, Ws,dGn,dBl,Cyn, Tk"
      11. BgColor$=" 7, 6 , 0, 4, 12, 11, 14, 10, 9, 3, 8, 15, 2, 1, 5, 13"
      12. Txtcolor$=" 0, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 0, 15, 15, 15, 0"
      13. Mul$="0.1 ,0.01,1 ,10 ,100 ,1 k,10 k,100k,1 M,10 M,,,,,,,"
      14. Prec$=" 5 %=J,10 %=K,, 1 %=F, 2 %=G,,,0.5 %=D,0.25%=C,0.1 %=B,0.05% ,,,,,,"
      15. luuup:
      16. Cls $A0A0A0:Font 2-2*ko&
      17. whileloop 16
      18. color val(substr$(Txtcolor$,&Loop,",")),val(substr$(BgColor$,&Loop,","))
      19. locate 2*&Loop,5 :print " "+substr$(Farbbez$,&Loop,",")+" ";
      20. locate 2*&Loop,19:print " "+substr$(Kurzbez$,&Loop,",")+" ";
      21. if &Loop=12:line 0,320 - width(%hwnd),320:line 210,0 - 210,width(%hwnd):endif
      22. if &Loop<13
      23. locate 2*&Loop,31:print " "+if(&loop>2,""," ")+if(&Loop>2,str$(&Loop-3),"")+" ";
      24. locate 2*&Loop,38:print " "+if(&loop>2,""," ")+if(&Loop>2,str$(&Loop-3),"")+" ";
      25. if ko&:locate 2*&Loop,45:print " "+if(&loop>2,""," ")+if(&Loop>2,str$(&Loop-3),"")+" ";:endif
      26. if &Loop<11
      27. locate 2*&Loop,45+7*ko&
      28. print "x "+if(ko&,format$("%g",10^(&Loop-3)),substr$(Mul$,&Loop,","))+" ";
      29. endif
      30. locate 2*&Loop,67:print if(substr$(Prec$,&Loop,",")>""," +/-","")+substr$(Prec$,&Loop,",");
      31. endif
      32. endwhile
      33. Waitinput
      34. case %key=ord("t"):ko&=not(ko&)
      35. goto "luuup"
      Alles anzeigen

      Gruß Volkmar
    • Da hast du natürlich vollkommen recht, lieber Volkmar! Fehler wurde oben korrigiert - und gleich noch zwei! :tomate:
      P.S: Noch einen entdeckt (Wenn was schiefgeht, dann gründlich!):

      Bitte in #42 die Zeile 25 ausbessern auf:
      if ko&:locate 2*&Loop,45:print " "+if(&loop>12,""," ")+str$(int(&Loop-3))+" ";:endif

      Dieser Beitrag wurde bereits 8 mal editiert, zuletzt von p. specht ()

    • Abt. Physikalische Einheiten im SI-System
      ==========================
      und einige andere, nachstehend für XProfan-Programme nutzbar gemacht. Interessanterweise sind Vorsätze wie Kilo, Mega etc. bei bestimmten Einheiten nicht erlaubt. Da Kilogramm bereits die SI-Basis ist und mehr als ein Vorsatz nicht erlaubt ist, gibt es also keine Kilokilogramm. Aber auch Milligrad Celsius wird man vergeblich suchen, von Zeitangaben in Hektosekunden ganz zu schweigen. Und dann gibt es auch noch sprachliche Einflüsse, sonst müsste es nämlich Hekto-Ar heissen statt Hektar. Das erleichtert nicht gerade die Programmierung von Aus- und Eingaben mit solchen Vorsätzen.
      Gruss

      Quellcode

      1. WindowTitle "Physikalische Einheiten im SI-System plus kompatible"
      2. Windowstyle 24:Window 0,0-%maxx,%maxy:cls:var SI$=\
      3. "Länge;l,L;Meter;m;1/299792458 Lichtsekunde#"+\
      4. "Masse;m,M;Kilogramm;kg;gen.Urkilogramm-hinterlegt bei Sevres#"+\
      5. "Zeitdauer;t,T;Sekunde;s;9192631770 Hyperfeinstruktur-Grundzustandsübergänge des Caesium-Isotops 133Cs#"+\
      6. "Uhrzeit;Z;HMS,hh:mm:ss.zht;24:60:60,000#"+\
      7. "Datum;D;JMD;JJJJ-MM-DD UTC+X.X;1970-01-01<Uxtm#"+\
      8. "El.Stromstärke;I,i;Ampere;A;Stromstärke die in zwei 1m entfernten el.Leitern 2*10^-7 N/m hervorruft#"+\
      9. "Thermmodyn.Temperatur;T,T;Kelvin;K;1/273.16 der Temp.d.Tripelpunkts v.Wasser (-0.01°C) def. Isotop-Zusammensetzg.#"+\
      10. "Temperatur;T;Grad_Celsius;°C,K-273.15;Raumtemperatur (Bei °C keine Einh.Vorsätze!)#"+\
      11. "Temperaturdifferenz;dT;Kelvin;K;Thermodyn.Temperaturdifferenz#"+\
      12. "Raumtemperaturdifferenz;dT;dGrad_Celsius;°C;Raumtemperaturdiffreenz (DIN 1301-1:2010 Anhang A Abschnitt A.5)#"+\
      13. "Stoffmenge;n,N;Mol;mol;Einzelteilchenanzahl wie Atome in 12g Kohlenstoffnuklid 12C in ungebund.Zustand enthalten sind.#"+\
      14. "Lichtstärke;I_v,J;Candela;cd;Lichtstärkeäquivalent zu monochrom. 540THz-Strahlung (~555 nm) bei Strahlstärke 1/683 W/sr#"+\
      15. "Winkel;<greek>;Radiant;rad;m/m;1#"+\
      16. "Raumwinkel;<greek>;Steradiant;sr;m^2/m^2;1#"+\
      17. "Frequenz;f;Hertz;Hz;s^-1#"+\
      18. "Kreisfrequenz;Omega;2*Pi*f;Ups;s^-1#"+\
      19. "Kraft;F;Newton;N;J/m;m·kg·s^-2#"+\
      20. "Kraftdruck;P;Pascal;Pa;N/m^2;m^-1·kg·s^-2#"+\
      21. "Mech.Spannung;P;Pascal;Pa;N/m^2;m^-1·kg·s^-2#"+\
      22. "Druck;P;Bar;bar,100000 Pa;0.1MN/m^2;m^-1·kg·s^-2#"+\
      23. "Energie;W;Joule;J;N·m,W·s;m^2·kg·s^-2#"+\
      24. "Arbeit;A;Joule;J;N·m,W·s;m^2·kg·s^-2#"+\
      25. "Wärmemenge;Q;Joule;J;N·m,W·s;m^2·kg·s^-2#"+\
      26. "Leistung;P;Watt;W;J/s,V A;m^2·kg·s^-3#"+\
      27. "El.Ladung;L;Coulomb;C;s·A#"+\
      28. "El.Spannung;U;Volt;V;W/A,J/C;m^2·kg·s^-3·A^-1#"+\
      29. "Potentialdifferenz;dU;Volt;V;W/A,J/C;m^2·kg·s^-3·A^-1#"+\
      30. "El.Kapazität;C;Farad;F,C/V;m^-2·kg^-1·s^4·A^2#"+\
      31. "El.Widerstand;R;Ohm;<greek>O,V/A;m^2·kg·s^-3·A^-2#"+\
      32. "El.Leitwert;L;Siemens;S,1/O;m^-2·kg^-1·s^3·A^2#"+\
      33. "Mag.Fluss;F;Weber;Wb,V·s;m^2·kg·s^-2·A^-1#"+\
      34. "Mag.Flussdichte;<greek>Phi;Tesla;T,Wb/m^2;kg·s^-2·A^-1#"+\
      35. "Induktion;<greek>Phi;Gauss;T;Wb/m^2;kg·s^-2·A^-1#"+\
      36. "Induktivität;H;Henry;H,Wb/A;m^2·kg·s^-2·A^-2#"+\
      37. "Celsius-Temperatur;T;Grad Celsius;°C;K#"+\
      38. "Lichtstrom;Phi;Lumen;lm,cd·sr;cd#"+\
      39. "Beleuchtungsstärke;S;Lux;lx,lm/m^2;m^-2·cd#"+\
      40. "Radioaktivität;R;Becquerel;Bq;s^-1#"+\
      41. "Energiedosis;G;Gray;Gy,J/kg;m^2·s^-2#"+\
      42. "Äquivalentdosis;S;Sievert;Sv,J/kg;m^2·s^-2#"+\
      43. "Katalytische Aktivität;K;Katal;kat;s^-1·mol#"+\
      44. "Magnetische Konstante;µ0,µ_vac;;H/m;4*pi*10^-7#"+\
      45. "Fläche;A;Quadratmeter,m²,1mx1m#"+\
      46. "Feldfläche;A;Morgen_;Mg,Viertelhektar vha veraltet#"+\
      47. "Ackerfläche;H;Hekt/o/ar;ha;100m*100m=1 Quadrathektometer#"+\
      48. "Wiesenfläche;A;Ar;ar;0.0001km²=0.01ha=1a=100m²#"+\
      49. "US-Fläche;A;Acre;0.40468564224 ha#"+\
      50. "Volumen;V;Kubikmeter;m³;1mx1mx1m#"+\
      51. "Volumen;V;Liter;ltr;1dm x 1dm x 1dm =0.001 m³"
      52. Declare i&,Einh$[]:Einh$[]=explode(SI$,"#"):clear SI$
      53. whileloop 0,sizeof(Einh$[])-1:i&=&Loop:print
      54. :whileloop 5:locate %csrlin,2+12*(&Loop-(&Loop=1))
      55. color 14,&Loop : print " "+substr$(Einh$[i&],&Loop,";")+" ";
      56. :endwhile:if %csrlin>50:waitinput:cls:endif:print
      57. endwhile:waitinput
      Alles anzeigen

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von p. specht ()

    • Fortsetzung zu oben:

      Abt. Ausgabe mit Einheitenvorsätzen
      =======================
      Hier am Beispiel der physikalischen Leistungseinheit "Watt", bei der es keine Ausnahmen von den Ausgaberegeln gibt. Wünschenswert wären aber z.B. Ausgaben wie 1/4 W (bei Kohleschichtwiderständen) etc., was nachstehend aber nicht berücksichtigt werden konnte.
      Gruss
      P.S.: Wie immer gilt: Demo, daher keine Gewähr!

      Quellcode

      1. Windowtitle "Werte-Formatierung gemäß ISO 2955 und DIN 66030 (Ausg. 2002-05) am Beispiel der Einheit WATT"
      2. Windowstyle 24:cls:font 2
      3. declare Vors$,Vorsz$,Vorsatz$,IsoMult$,Wert$,Wert!,IsoVs$,Einheit$
      4. Vorsz$="-,y,z,a,f,p,n,µ,m,c,d,,da,h,k,M,G,T,P,E,Z,Y,+"
      5. Vors$="-,y,z,a,f,p,n,µ,m,,k,M,G,T,P,E,Z,Y,+"
      6. Vorsatz$="-,Yokto,Zepto,Atto,Femto,Pico,Nano,Micro,Centi,Dezi,,Deka,Hekto,Kilo,Mega,Giga,Tera,Peta,Exa,Zetta,Yotta,+"
      7. IsoMult$="1e-,1e-24,1e-21,1e-18,1e-15,1e-12,1e-9,1e-6,1e-3,0.01,0.1,1,10,100,1e3,1e6,1e9,1e12,1e15,1e18,1e21,1e24,1e+"
      8. repeat
      9. font 2:Print "\n Wieviel Watt?: ";:Input Wert$:wert!=val(translate$(wert$,",","."))
      10. locate %csrlin-1,36:font 0:print " ";Prefix(Wert!);"W"
      11. until 0
      12. proc Prefix :parameters Wert!
      13. var mant!=abs(Wert!):var vz$=if(mant!=Wert!," ","-")
      14. var ex&=0:While mant!>=1000:mant!=mant!/1000:inc ex&,3:endwhile
      15. if mant!<>0:While (mant!<1):mant!=mant!*1000:dec ex&,3:endwhile:endif
      16. if ex&>24 :ex&=0:return translate$(format$("%g",wert!),",",".")+" "
      17. elseif ex&<-24:ex&=0:return translate$(format$("%g",wert!),",",".")+" "
      18. else
      19. return vz$+translate$(format$("%g",mant!),".",",")+" "+substr$(vors$,(ex&+30)/3,",")
      20. endif
      21. endproc
      Alles anzeigen

      Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von p. specht ()

    • @Marc: Das wird leider keiner machen... Ich bleib´ daher weiter bloß Mikronär!

      Abt. Scherze und Scherzprogramme
      ======================
      Weil wir gerade beim scherzen sind: Nachstehend ein Spassprogramm, das zu Überlegungen anregen kkönnte, ob es die angegebene physikalische Größe vielleicht wirklich geben kann - oder eher nicht!
      Gruss

      Quellcode

      1. WindowTitle " TARPUG ; - ) - The Absolutely Ridiculous Physical Units Generator ; - ) "
      2. ' (S) Scherzwär 2016-12 by P.Specht, Wien/AT. M i t F e h l e r g a r a n t i e !
      3. WindowStyle 24:Window 0,0 - %maxx,%maxy/6:cls rgb(121,121,121):randomize
      4. Declare units$,tarpug$,ex$,flg&
      5. units$="m,kg,s,A,K,mol,cd,rad,sr"
      6. usepen 0,1,rgb(255,0,0):usebrush 1,rgb(255,0,0)
      7. REPEAT
      8. flg&=0:cls rgb(40+rnd(100),40+rnd(100),40+rnd(100))
      9. tarpug$=if(rnd()<0.5,"-"," ")+format$("##0.00",rnd()*1000)
      10. Whileloop 9
      11. ex$=str$(int(rnd(13)-6)):ex$=if(rnd()<0.55,"0",ex$)
      12. if ex$<>"0"
      13. inc flg&
      14. tarpug$=tarpug$+if(flg&=1," [","*")+substr$(units$,&loop,",")+if(ex$<>"1","^"+ex$,"")
      15. endif
      16. endwhile
      17. tarpug$=tarpug$+"]"
      18. TextColor rgb(255,255,0),-1
      19. UseFont "ARIAL",55,17,0,rnd(2),0
      20. case rnd()<0.1:tarpug$="Just for fun! Nur ein Scherz!"
      21. DrawText width(%hwnd)/2-10*len(tarpug$),15,tarpug$
      22. WaitInput 4000
      23. case %key>0:end
      24. UNTIL 0
      Alles anzeigen
    • Abt. Mathe-Rätsel "Würfelhalbierung"
      ============================
      Wer aus einem grossen Eiswürfel der Breite X zwei kleinere, zueinander gleich große Eiiswürfel machen will, ist gut beraten deren Seitenlängen Y mit 0.79370052598409973737585281963615 * X anzusetzen.
      Gruss

      P.S.: Aber warum?
      PPS: Und was, wenn ich DREI kleinere Eiswürfel daraus machen will?
    • p. specht schrieb:

      Abt. Mathe-Rätsel "Würfelhalbierung"
      ============================
      Wer aus einem grossen Eiswürfel der Breite X zwei kleinere, zueinander gleich große Eiiswürfel machen will, ist gut beraten deren Seitenlängen Y mit 0.79370052598409973737585281963615 * X anzusetzen.
      Gruss

      P.S.: Aber warum?
      PPS: Und was, wenn ich DREI kleinere Eiswürfel daraus machen will?
      Lass mich raten was dü früher von Beruf warst. Mathelehrer?
    • Da bisher keine Antwort kam (wahrscheinlich weil die
      Aufgabe viel zu einfach war), hier die Auflösung:

      V_großerwürfel = x * x * x = x^3
      V_kleinerwürfel = y * y * y = y^3
      Bedingung: y^3 = 1/2 * x^3 ,
      daher: x^3 = 2 * y^3 ,
      bzw.: x^3 / y^3 = 2 ,
      identisch mit: (x/y)^3 = 2 ,
      woraus folgt: x / y = Kubikwurzel(2) ,
      nach y aufgelöst: y = x * 1 / Kubikwurzel(2) =
      y = x*1/(2^1/3) , d.h.:
      y = x*2^( -1/3) , also:
      y = x * 0,79370052598409973737585281963615...,
      q.e.d.

      Allgemein gilt: Will man aus einem großen Würfel n kleinere machen,
      dann ist die Seitenlänge der kleinen Würfel:
      y = x * n^(-1/3)

      Was uns zum im PPS des Rätsels angesprochenen Teil bringt:
      Werden 3 Würfelchen gewünscht, dann ist der Faktor also:
      y = x * 3^(-1/3) = x * 0,69336127435063470484335227478596.

      Gruss