Mathematik mit VBA - Teil 3: Dreiecksberechnung

    • VBA: Sonstige

    Es gibt 12 Antworten in diesem Thema. Der letzte Beitrag () ist von roddy.

      Mathematik mit VBA - Teil 3: Dreiecksberechnung

      Da bin ich wieder. Diesmal widme ich mich der Berechnung von Dreieck-Werten.

      Zunächst jedoch für diejenigen, die sich fragen, was Teil 1 und Teil 2 waren, hier die Links:

      [VBA: Sonstige/Allgemein] Mathematik mit VBA - Teil 1: Primzahlen, Bruchrechnen, Kombinatronik und Statistik

      [VBA: Sonstige/Allgemein] Mathematik mit VBA - Teil 2: komplexe Zahlen und Nullstellen ganzrationaler Funktionen

      Damit klar ist, welche Größe wo am Dreieck ist, hier zwei Zeichnungen:



      Ich benutze ein Klasenmodul, das ich „Dreieck“ nenne. Es ist übrigens mein erstes Klassenmodul.

      Da der Code recht umfangreich ist (1422 Zeilen), habe ich zusätzlich das Klassenmodul hochgeladen:

      Dreieck.zip

      Wenn ein Wert festgelegt wird (z. B. SeiteA), werden alle Werte ermittelt, die aufgrund der bisher bestimmten Werte berechnet werden können. Wenn also beispielsweise SeiteA bereits bestimmt ist und dann HöheHa festgelegt wird, wird automatisch der Flächeninhalt berechnet.

      Dies sind die Elemente, auf die außerhalb des Klassenmoduls zugegriffen werden kann:

      Quellcode

      1. Eigenschaften
      3. Name Datentyp Zahlenbereich Bemerkung
      5. Flächeninhalt Double > 0
      6. HöheHa Double > 0
      7. HöheHb Double > 0
      8. HöheHc Double > 0
      9. Inkreisradius Double > 0
      10. Längeneinheit String Standardwert: NullString ("")
      11. SeiteA Double > 0
      12. SeiteB Double > 0
      13. SeiteC Double > 0
      14. StreckePa Double beliebig
      15. StreckePb Double beliebig
      16. StreckePc Double beliebig
      17. StreckeQa Double beliebig
      18. StreckeQb Double beliebig
      19. StreckeQc Double beliebig
      20. Umfang Double > 0
      21. Umkreisradius Double > 0
      22. WinkelAlpha Double > 0, < pi Bogenmaß
      23. WinkelAlpha° Double > 0, < 180 Gradmaß
      24. WinkelBeta Double > 0, < pi Bogenmaß
      25. WinkelBeta° Double > 0, < 180 Gradmaß
      26. WinkelGamma Double > 0, < pi Bogenmaß
      27. WinkelGamma° Double > 0, < 180 Gradmaß
      30. Methoden mit Rückgabewert
      32. Name Datentyp Parameter Bemerkung
      34. alleWerte Boolean - Gibt zurück, ob alle Werte bestimmt sind.
      35. AnzahlWerte Integer - Gibt die Anzahl der bestimmten Werte zurück.
      36. pi Double - Gibt pi zurück.
      37. Rechenweg String - Gibt eine Liste mit den verwendeten Formeln zurück.
      38. Werteliste String Nachkommastellen Gibt eine Liste der Werte zurück.
      39. WertelisteKurz String - Gibt eine Liste der bestimmten Werte zurück (Kurzform).
      42. Methoden ohne Rückgabewert
      44. Name Parameter Bemerkung
      46. PlausiPrüfung - Zeigt nennenswerte Differenzen an.
      47. Zurücksetzen - Setzt alle Werte zurück.


      Die PlausiPrüfung diente mir vor allem in der Testphase, um Berechnungsfehler und andere Fehler im Code aufzuspüren. Eigentlich bin ich soweit, zu sagen, dass der Code fertig ist. Da ich jedoch aufgrund der Vielzahl von Eingabemöglichkeiten nicht alles testen konnte, bitte ich diejenigen, die das ausprobieren/verwenden, mir mitzuteilen, wenn bei der PlausiPrüfung eine Meldung mit einem „Critical“-Symbol erscheint (weißes X auf rotem Punkt) oder sonstige merkwürdige Fehlermeldungen oder Ergebnisse haben.

      Auch für sonstige Anregungen, Kritik u. ä. bin ich offen.


      So sieht beispielsweise die Anwendung in einem separaten Modul aus:

      Visual Basic-Quellcode

      1. Sub test()
      2. Dim dr As New Dreieck
      3. With dr
      4. .SeiteA = 3
      5. .Längeneinheit = "cm"
      6. .WinkelAlpha° = 60
      7. .WinkelGamma = .pi / 4
      8. MsgBox .SeiteB 'Gibt den Wert von SeiteB aus.
      9. MsgBox .SeiteC 'Gibt den Wert von SeiteC aus.
      10. MsgBox .Werteliste(3) 'Gibt eine Liste der Werte mit 3 Nachkommastellen aus.
      11. MsgBox .Werteliste 'Gibt eine Liste der Werte im Standard-Zahlenformat aus.
      12. MsgBox .Rechenweg 'Gibt eine Liste mit den verwendeten Formeln und Rechenergebnissen aus.
      13. .PlausiPrüfung 'Gibt nennenswerte Differenzen aus.
      14. End With
      15. End Sub

      Hier zunächst die Enumerationen und Variablen auf Modulebene:

      Visual Basic-Quellcode

      1. Private Enum drFehlertyp
      2. drKeinWert = 513
      3. drBereitsBestimmt = 514
      4. drZahlenbereich = 515
      5. drWinkelbereich = 516
      6. drUnmöglich = 517
      7. End Enum
      9. Private Enum drSeite
      10. drA = 1
      11. drB = 2
      12. drC = 3
      13. End Enum
      15. Private Enum drWinkel
      16. drAlpha = 1
      17. drBeta = 2
      18. drGamma = 3
      19. End Enum
      21. Private Enum drHöhe
      22. drHa = 1
      23. drHb = 2
      24. drHc = 3
      25. End Enum
      27. 'Hilfsvariablen, die die Werte enthalten
      28. Private a As Double, b As Double, c As Double
      29. Private alpha As Double, beta As Double, gamma As Double
      30. Private ha As Double, hb As Double, hc As Double
      31. Private U As Double, F As Double
      32. Private rho As Double, r As Double
      33. Private pa As Double, pb As Double, pc As Double
      34. Private qa As Double, qb As Double, qc As Double
      36. 'Hilfsvariablen, die angeben, ob ein Wert bestimmt ist oder nicht.
      37. Private a1 As Boolean, b1 As Boolean, c1 As Boolean
      38. Private alpha1 As Boolean, beta1 As Boolean, gamma1 As Boolean
      39. Private ha1 As Boolean, hb1 As Boolean, hc1 As Boolean
      40. Private U1 As Boolean, F1 As Boolean
      41. Private rho1 As Boolean, r1 As Boolean
      42. Private pa1 As Boolean, pb1 As Boolean, pc1 As Boolean
      43. Private qa1 As Boolean, qb1 As Boolean, qc1 As Boolean
      45. Public Längeneinheit As String
      46. Private Formeln As String


      Hier noch grundlegende Funktionen und Prozeduren:

      Visual Basic-Quellcode

      1. Public Function pi() As Double
      3. pi = 4 * Atn(1)
      5. End Function
      8. Public Sub Zurücksetzen()
      9. 'Löscht alle vorgenommenen Eingaben und Berechnungen
      11. a1 = False
      12. b1 = False
      13. c1 = False
      14. alpha1 = False
      15. beta1 = False
      16. gamma1 = False
      17. ha1 = False
      18. hb1 = False
      19. hc1 = False
      20. U1 = False
      21. F1 = False
      22. rho1 = False
      23. r1 = False
      24. pa1 = False
      25. pb1 = False
      26. pc1 = False
      27. qa1 = False
      28. qb1 = False
      29. qc1 = False
      30. Längeneinheit = ""
      31. Formeln = ""
      33. End Sub
      36. Private Sub Fehlermeldung(Fehler As drFehlertyp, Optional Werttext As String = "Wert", Optional Wert As Double)
      38. Dim Fehlertext As String
      40. Select Case Fehler
      41. Case drKeinWert
      42. Fehlertext = Werttext & " ist nicht bestimmt."
      43. Case drBereitsBestimmt
      44. Fehlertext = Werttext & " ist bereits bestimmt: " & Wert
      45. If Left(Werttext, 6) = "Winkel" Then Fehlertext = Fehlertext & " (= " & Wert / pi * 180 & "°)"
      46. Case drZahlenbereich
      47. Fehlertext = Werttext & " muss größer als 0 sein: " & Wert
      48. Case drWinkelbereich
      49. Fehlertext = Werttext & " muss größer als 0 und kleiner als pi (= 180°) sein:" & vbCrLf & Wert & " (= " & Wert / pi * 180 & "°)"
      50. Case drUnmöglich
      51. Fehlertext = "Unmögliche Wertekombination für ein Dreieck:" & vbCrLf & vbCrLf & WertelisteKurz(Werttext)
      52. Case Else: Stop
      53. End Select
      54. Err.Raise vbObjectError + Fehler, , vbCrLf & "Dreieck-Klasse:" & vbCrLf & vbCrLf & Fehlertext
      56. End Sub
      59. Private Function Wurzel(x As Double, Werte As String) As Double
      61. If x < 0 Then Fehlermeldung drUnmöglich, Werte
      62. Wurzel = Sqr(x)
      64. End Function
      67. Private Function Wurzel3(x As Double) As Double
      69. Wurzel3 = Sgn(x) * Abs(x) ^ (1 / 3)
      71. End Function
      74. Private Function ArcCos(x As Double, Werte As String) As Double
      76. If x < -1 Or x > 1 Then Fehlermeldung drUnmöglich, Werte
      77. If x = 1 Then ArcCos = 0 Else ArcCos = Atn(-x / Wurzel(-x * x + 1, Werte)) + 2 * Atn(1)
      79. End Function

      In den folgenden Prozeduren werden die Werte, die aufgrund vorhandener Werte berechnet werden können, ermittelt. Ich habe gleichartige Formeln „gruppiert“ und für jede Gruppe eine Prozedur gemacht.

      Visual Basic-Quellcode

      1. Private Sub Umfangformel()
      2. 'Berechnet fehlende Werte aufgrund der Umfangformel, sofern möglich.
      4. If (Not a1) And b1 And c1 And U1 Then
      5. Formeln = Formeln & vbCrLf & "U=a+b+c"
      6. SeiteA = U - b - c
      7. ElseIf a1 And (Not b1) And c1 And U1 Then
      8. Formeln = Formeln & vbCrLf & "U=a+b+c"
      9. SeiteB = U - a - c
      10. ElseIf a1 And b1 And (Not c1) And U1 Then
      11. Formeln = Formeln & vbCrLf & "U=a+b+c"
      12. SeiteC = U - a - b
      13. ElseIf a1 And b1 And c1 And (Not U1) Then
      14. Formeln = Formeln & vbCrLf & "U=a+b+c"
      15. Umfang = a + b + c
      16. End If
      18. End Sub
      21. Private Sub Teilstrecken(Seite As drSeite)
      22. 'Berechnet fehlende Werte aufgrund der Aufteilung einer Seite in p und q, sofern möglich.
      24. Select Case Seite
      25. Case drA
      26. If (Not a1) And pa1 And qa1 Then
      27. Formeln = Formeln & vbCrLf & "a=pa+qa"
      28. SeiteA = pa + qa
      29. ElseIf a1 And (Not pa1) And qa1 Then
      30. Formeln = Formeln & vbCrLf & "a=pa+qa"
      31. StreckePa = a - qa
      32. ElseIf a1 And pa1 And (Not qa1) Then
      33. Formeln = Formeln & vbCrLf & "a=pa+qa"
      34. StreckeQa = a - pa
      35. End If
      36. Case drB
      37. If (Not b1) And pb1 And qb1 Then
      38. Formeln = Formeln & vbCrLf & "b=pb+qb"
      39. SeiteB = pb + qb
      40. ElseIf b1 And (Not pb1) And qb1 Then
      41. Formeln = Formeln & vbCrLf & "b=pb+qb"
      42. StreckePb = b - qb
      43. ElseIf b1 And pb1 And (Not qb1) Then
      44. Formeln = Formeln & vbCrLf & "b=pb+qb"
      45. StreckeQb = b - pb
      46. End If
      47. Case drC
      48. If (Not c1) And pc1 And qc1 Then
      49. Formeln = Formeln & vbCrLf & "c=pc+qc"
      50. SeiteC = pc + qc
      51. ElseIf c1 And (Not pc1) And qc1 Then
      52. Formeln = Formeln & vbCrLf & "c=pc+qc"
      53. StreckePc = c - qc
      54. ElseIf c1 And pc1 And (Not qc1) Then
      55. Formeln = Formeln & vbCrLf & "c=pc+qc"
      56. StreckeQc = c - pc
      57. End If
      58. End Select
      60. End Sub
      63. Private Sub Winkelsumme()
      64. 'Berechnet fehlende Werte aufgrund der Winkelsumme von 180°, sofern möglich.
      66. If (Not alpha1) And beta1 And gamma1 Then
      67. Formeln = Formeln & vbCrLf & "alpha+beta+gamma=180°"
      68. WinkelAlpha = pi - beta - gamma
      69. ElseIf alpha1 And (Not beta1) And gamma1 Then
      70. Formeln = Formeln & vbCrLf & "alpha+beta+gamma=180°"
      71. WinkelBeta = pi - alpha - gamma
      72. ElseIf alpha1 And beta1 And (Not gamma1) Then
      73. Formeln = Formeln & vbCrLf & "alpha+beta+gamma=180°"
      74. WinkelGamma = pi - alpha - beta
      75. End If
      77. End Sub
      80. Private Sub Fläche(Seite As drSeite)
      81. 'Berechnet fehlende Werte aufgrund von Flächeninhaltsformeln, sofern möglich.
      83. Select Case Seite
      84. Case drA
      85. If (Not a1) And ha1 And F1 Then
      86. Formeln = Formeln & vbCrLf & "F=a*ha/2"
      87. SeiteA = 2 * F / ha
      88. ElseIf a1 And (Not ha1) And F1 Then
      89. Formeln = Formeln & vbCrLf & "F=a*ha/2"
      90. HöheHa = 2 * F / a
      91. ElseIf a1 And ha1 And (Not F1) Then
      92. Formeln = Formeln & vbCrLf & "F=a*ha/2"
      93. Flächeninhalt = a * ha / 2
      94. End If
      95. Case drB
      96. If (Not b1) And hb1 And F1 Then
      97. Formeln = Formeln & vbCrLf & "F=b*hb/2"
      98. SeiteB = 2 * F / hb
      99. ElseIf b1 And (Not hb1) And F1 Then
      100. Formeln = Formeln & vbCrLf & "F=b*hb/2"
      101. HöheHb = 2 * F / b
      102. ElseIf b1 And hb1 And (Not F1) Then
      103. Formeln = Formeln & vbCrLf & "F=b*hb/2"
      104. Flächeninhalt = b * hb / 2
      105. End If
      106. Case drC
      107. If (Not c1) And hc1 And F1 Then
      108. Formeln = Formeln & vbCrLf & "F=c*hc/2"
      109. SeiteC = 2 * F / hc
      110. ElseIf c1 And (Not hc1) And F1 Then
      111. Formeln = Formeln & vbCrLf & "F=c*hc/2"
      112. HöheHc = 2 * F / c
      113. ElseIf c1 And hc1 And (Not F1) Then
      114. Formeln = Formeln & vbCrLf & "F=c*hc/2"
      115. Flächeninhalt = c * hc / 2
      116. End If
      117. End Select
      119. End Sub

      Visual Basic-Quellcode

      1. Private Sub Umkreis(Höhe As drHöhe)
      2. 'Berechnet fehlende Werte aufgrund von Umkreisformeln, sofern möglich.
      4. Select Case Höhe
      5. Case drHa
      6. If (Not b1) And c1 And ha1 And r1 Then
      7. Formeln = Formeln & vbCrLf & "r=bc/2ha"
      8. SeiteB = 2 * ha * r / c
      9. ElseIf b1 And (Not c1) And ha1 And r1 Then
      10. Formeln = Formeln & vbCrLf & "r=bc/2ha"
      11. SeiteC = 2 * ha * r / b
      12. ElseIf b1 And c1 And (Not ha1) And r1 Then
      13. Formeln = Formeln & vbCrLf & "r=bc/2ha"
      14. HöheHa = b * c / (2 * r)
      15. ElseIf b1 And c1 And ha1 And (Not r1) Then
      16. Formeln = Formeln & vbCrLf & "r=bc/2ha"
      17. Umkreisradius = b * c / (2 * ha)
      18. End If
      19. Case drHb
      20. If (Not a1) And c1 And hb1 And r1 Then
      21. Formeln = Formeln & vbCrLf & "r=ac/2hb"
      22. SeiteA = 2 * hb * r / c
      23. ElseIf a1 And (Not c1) And hb1 And r1 Then
      24. Formeln = Formeln & vbCrLf & "r=ac/2hb"
      25. SeiteC = 2 * hb * r / a
      26. ElseIf a1 And c1 And (Not hb1) And r1 Then
      27. Formeln = Formeln & vbCrLf & "r=ac/2hb"
      28. HöheHb = a * c / (2 * r)
      29. ElseIf a1 And c1 And hb1 And (Not r1) Then
      30. Formeln = Formeln & vbCrLf & "r=ac/2hb"
      31. Umkreisradius = a * c / (2 * hb)
      32. End If
      33. Case drHc
      34. If (Not a1) And b1 And hc1 And r1 Then
      35. Formeln = Formeln & vbCrLf & "r=ab/2hc"
      36. SeiteA = 2 * hc * r / b
      37. ElseIf a1 And (Not b1) And hc1 And r1 Then
      38. Formeln = Formeln & vbCrLf & "r=ab/2hc"
      39. SeiteB = 2 * hc * r / a
      40. ElseIf a1 And b1 And (Not hc1) And r1 Then
      41. Formeln = Formeln & vbCrLf & "r=ab/2hc"
      42. HöheHc = a * b / (2 * r)
      43. ElseIf a1 And b1 And hc1 And (Not r1) Then
      44. Formeln = Formeln & vbCrLf & "r=ab/2hc"
      45. Umkreisradius = a * b / (2 * hc)
      46. End If
      47. End Select
      49. End Sub
      52. Private Sub SinFormel(Seite As drSeite, Höhe As drHöhe)
      53. 'Berechnet fehlende Werte aufgrund von Formeln, die den Sinus benutzen, sofern möglich.
      55. Select Case Seite + Höhe * 3
      56. Case drA + drHb * 3
      57. If (Not a1) And hb1 And gamma1 Then
      58. Formeln = Formeln & vbCrLf & "hb=a*sin(gamma)"
      59. SeiteA = hb / Sin(gamma)
      60. ElseIf a1 And (Not hb1) And gamma1 Then
      61. Formeln = Formeln & vbCrLf & "hb=a*sin(gamma)"
      62. HöheHb = a * Sin(gamma)
      63. End If
      64. Case drA + drHc * 3
      65. If (Not a1) And hc1 And beta1 Then
      66. Formeln = Formeln & vbCrLf & "hc=a*sin(beta)"
      67. SeiteA = hc / Sin(beta)
      68. ElseIf a1 And (Not hc1) And beta1 Then
      69. Formeln = Formeln & vbCrLf & "hc=a*sin(beta)"
      70. HöheHc = a * Sin(beta)
      71. End If
      72. Case drB + drHa * 3
      73. If (Not b1) And ha1 And gamma1 Then
      74. Formeln = Formeln & vbCrLf & "ha=b*sin(gamma)"
      75. SeiteB = ha / Sin(gamma)
      76. ElseIf b1 And (Not ha1) And gamma1 Then
      77. Formeln = Formeln & vbCrLf & "ha=b*sin(gamma)"
      78. HöheHa = b * Sin(gamma)
      79. End If
      80. Case drB + drHc * 3
      81. If (Not b1) And hc1 And alpha1 Then
      82. Formeln = Formeln & vbCrLf & "hc=b*sin(alpha)"
      83. SeiteB = hc / Sin(alpha)
      84. ElseIf b1 And (Not hc1) And alpha1 Then
      85. Formeln = Formeln & vbCrLf & "hc=b*sin(alpha)"
      86. HöheHc = b * Sin(alpha)
      87. End If
      88. Case drC + drHa * 3
      89. If (Not c1) And ha1 And beta1 Then
      90. Formeln = Formeln & vbCrLf & "ha=c*sin(beta)"
      91. SeiteC = ha / Sin(beta)
      92. ElseIf c1 And (Not ha1) And beta1 Then
      93. Formeln = Formeln & vbCrLf & "ha=c*sin(beta)"
      94. HöheHa = c * Sin(beta)
      95. End If
      96. Case drC + drHb * 3
      97. If (Not c1) And hb1 And alpha1 Then
      98. Formeln = Formeln & vbCrLf & "hb=c*sin(alpha)"
      99. SeiteC = hb / Sin(alpha)
      100. ElseIf c1 And (Not hb1) And alpha1 Then
      101. Formeln = Formeln & vbCrLf & "hb=c*sin(alpha)"
      102. HöheHb = c * Sin(alpha)
      103. End If
      104. Case Else: Stop
      105. End Select
      107. End Sub

      Visual Basic-Quellcode

      1. Private Sub CosFormel(Seite As drSeite, Winkel As drWinkel)
      2. 'Berechnet fehlende Werte aufgrund von Formeln, die den Kosinus benutzen, sofern möglich.
      4. Select Case Seite + Winkel * 3
      5. Case drA + drBeta * 3
      6. If (Not a1) And beta1 And qc1 Then
      7. Formeln = Formeln & vbCrLf & "qc=a*cos(beta)"
      8. SeiteA = qc / Cos(beta)
      9. ElseIf a1 And (Not beta1) And qc1 Then
      10. Formeln = Formeln & vbCrLf & "qc=a*cos(beta)"
      11. WinkelBeta = ArcCos(qc / a, "qc,a")
      12. ElseIf a1 And beta1 And (Not qc1) Then
      13. Formeln = Formeln & vbCrLf & "qc=a*cos(beta)"
      14. StreckeQc = a * Cos(beta)
      15. End If
      16. Case drA + drGamma * 3
      17. If (Not a1) And gamma1 And pb1 Then
      18. Formeln = Formeln & vbCrLf & "pb=a*cos(gamma)"
      19. SeiteA = pb / Cos(gamma)
      20. ElseIf a1 And (Not gamma1) And pb1 Then
      21. Formeln = Formeln & vbCrLf & "pb=a*cos(gamma)"
      22. WinkelGamma = ArcCos(pb / a, "pb,a")
      23. ElseIf a1 And gamma1 And (Not pb1) Then
      24. Formeln = Formeln & vbCrLf & "pb=a*cos(gamma)"
      25. StreckePb = a * Cos(gamma)
      26. End If
      27. Case drB + drAlpha * 3
      28. If (Not b1) And alpha1 And pc1 Then
      29. Formeln = Formeln & vbCrLf & "pc=b*cos(alpha)"
      30. SeiteB = pc / Cos(alpha)
      31. ElseIf b1 And (Not alpha1) And pc1 Then
      32. Formeln = Formeln & vbCrLf & "pc=b*cos(alpha)"
      33. WinkelAlpha = ArcCos(pc / b, "pc,b")
      34. ElseIf b1 And alpha1 And (Not pc1) Then
      35. Formeln = Formeln & vbCrLf & "pc=b*cos(alpha)"
      36. StreckePc = b * Cos(alpha)
      37. End If
      38. Case drB + drGamma * 3
      39. If (Not b1) And gamma1 And qa1 Then
      40. Formeln = Formeln & vbCrLf & "qa=b*cos(gamma)"
      41. SeiteB = qa / Cos(gamma)
      42. ElseIf b1 And (Not gamma1) And qa1 Then
      43. Formeln = Formeln & vbCrLf & "qa=b*cos(gamma)"
      44. WinkelGamma = ArcCos(qa / b, "qa,b")
      45. ElseIf b1 And gamma1 And (Not qa1) Then
      46. Formeln = Formeln & vbCrLf & "qa=b*cos(gamma)"
      47. StreckeQa = b * Cos(gamma)
      48. End If
      49. Case drC + drAlpha * 3
      50. If (Not c1) And alpha1 And qb1 Then
      51. Formeln = Formeln & vbCrLf & "qb=c*cos(alpha)"
      52. SeiteC = qb / Cos(alpha)
      53. ElseIf c1 And (Not alpha1) And qb1 Then
      54. Formeln = Formeln & vbCrLf & "qb=c*cos(alpha)"
      55. WinkelAlpha = ArcCos(qb / c, "qb,c")
      56. ElseIf c1 And alpha1 And (Not qb1) Then
      57. Formeln = Formeln & vbCrLf & "qb=c*cos(alpha)"
      58. StreckeQb = c * Cos(alpha)
      59. End If
      60. Case drC + drBeta * 3
      61. If (Not c1) And beta1 And pa1 Then
      62. Formeln = Formeln & vbCrLf & "pa=c*cos(beta)"
      63. SeiteC = pa / Cos(beta)
      64. ElseIf c1 And (Not beta1) And pa1 Then
      65. Formeln = Formeln & vbCrLf & "pa=c*cos(beta)"
      66. WinkelBeta = ArcCos(pa / c, "pa,c")
      67. ElseIf c1 And beta1 And (Not pa1) Then
      68. Formeln = Formeln & vbCrLf & "pa=c*cos(beta)"
      69. StreckePa = c * Cos(beta)
      70. End If
      71. Case Else: Stop
      72. End Select
      74. End Sub
      77. Private Sub Pythagoras(Seite As drSeite, Höhe As drHöhe)
      78. 'Berechnet fehlende Werte aufgrund von Formeln, die auf dem Satz des Pythagoras beruhen, sofern möglich.
      80. Select Case Seite + Höhe * 3
      81. Case drA + drHb * 3
      82. If (Not a1) And hb1 And pb1 Then
      83. Formeln = Formeln & vbCrLf & "pb²+hb²=a²"
      84. SeiteA = Wurzel(pb ^ 2 + hb ^ 2, "pb,hb")
      85. ElseIf a1 And (Not hb1) And pb1 Then
      86. Formeln = Formeln & vbCrLf & "pb²+hb²=a²"
      87. HöheHb = Wurzel(a ^ 2 - pb ^ 2, "a,pb")
      88. End If
      89. Case drA + drHc * 3
      90. If (Not a1) And hc1 And qc1 Then
      91. Formeln = Formeln & vbCrLf & "qc²+hc²=a²"
      92. SeiteA = Wurzel(qc ^ 2 + hc ^ 2, "qc,hc")
      93. ElseIf a1 And (Not hc1) And qc1 Then
      94. Formeln = Formeln & vbCrLf & "qc²+hc²=a²"
      95. HöheHc = Wurzel(a ^ 2 - qc ^ 2, "a,qc")
      96. End If
      97. Case drB + drHa * 3
      98. If (Not b1) And ha1 And qa1 Then
      99. Formeln = Formeln & vbCrLf & "qa²+ha²=b²"
      100. SeiteB = Wurzel(qa ^ 2 + ha ^ 2, "qa,ha")
      101. ElseIf b1 And (Not ha1) And qa1 Then
      102. Formeln = Formeln & vbCrLf & "qa²+ha²=b²"
      103. HöheHa = Wurzel(b ^ 2 - qa ^ 2, "b,qa")
      104. End If
      105. Case drB + drHc * 3
      106. If (Not b1) And hc1 And pc1 Then
      107. Formeln = Formeln & vbCrLf & "pc²+hc²=b²"
      108. SeiteB = Wurzel(pc ^ 2 + hc ^ 2, "pc,hc")
      109. ElseIf b1 And (Not hc1) And pc1 Then
      110. Formeln = Formeln & vbCrLf & "pc²+hc²=b²"
      111. HöheHc = Wurzel(b ^ 2 - pc ^ 2, "b,pc")
      112. End If
      113. Case drC + drHa * 3
      114. If (Not c1) And ha1 And pa1 Then
      115. Formeln = Formeln & vbCrLf & "pa²+ha²=c²"
      116. SeiteC = Wurzel(pa ^ 2 + ha ^ 2, "pa,ha")
      117. ElseIf c1 And (Not ha1) And pa1 Then
      118. Formeln = Formeln & vbCrLf & "pa²+ha²=c²"
      119. HöheHa = Wurzel(c ^ 2 - pa ^ 2, "c,pa")
      120. End If
      121. Case drC + drHb * 3
      122. If (Not c1) And hb1 And qb1 Then
      123. Formeln = Formeln & vbCrLf & "qb²+hb²=c²"
      124. SeiteC = Wurzel(qb ^ 2 + hb ^ 2, "qb,hb")
      125. ElseIf c1 And (Not hb1) And qb1 Then
      126. Formeln = Formeln & vbCrLf & "qb²+hb²=c²"
      127. HöheHb = Wurzel(c ^ 2 - qb ^ 2, "c,qb")
      128. End If
      129. Case Else: Stop
      130. End Select
      132. End Sub

      Visual Basic-Quellcode

      1. Private Sub FlächeABC()
      2. 'Berechnet fehlende Werte aufgrund der Flächeninhaltsformel mit a, b und c, sofern möglich.
      4. Dim alt As Double, neu As Double, s As Double
      5. Dim davor As Double, danach As Double
      7. If a1 And b1 And c1 And F1 Then
      8. alt = F
      9. s = (a + b + c) / 2
      10. neu = Wurzel(s * (s - a) * (s - b) * (s - c), "a,b,c")
      11. If Abs(neu - alt) > 10 ^ -6 Then Fehlermeldung drUnmöglich, "a,b,c,F"
      12. ElseIf (Not a1) And b1 And c1 And F1 Then
      13. Formeln = Formeln & vbCrLf & "F=Sqr(s*(s-a)*(s-b)*(s-c)) mit s=(a+b+c)/2"
      14. davor = b ^ 2 + c ^ 2
      15. danach = 2 * Wurzel(b ^ 2 * c ^ 2 - 4 * F ^ 2, "b,c,F")
      16. If davor - danach < 0 Or danach = 0 Then SeiteA = Wurzel(davor + danach, "b,c,F") Else Formeln = Formeln & vbCrLf & " a--"
      17. ElseIf a1 And (Not b1) And c1 And F1 Then
      18. Formeln = Formeln & vbCrLf & "F=Sqr(s*(s-a)*(s-b)*(s-c)) mit s=(a+b+c)/2"
      19. davor = a ^ 2 + c ^ 2
      20. danach = 2 * Wurzel(a ^ 2 * c ^ 2 - 4 * F ^ 2, "a,c,F")
      21. If davor - danach < 0 Or danach = 0 Then SeiteB = Wurzel(davor + danach, "a,c,F") Else Formeln = Formeln & vbCrLf & " b--"
      22. ElseIf a1 And b1 And (Not c1) And F1 Then
      23. Formeln = Formeln & vbCrLf & "F=Sqr(s*(s-a)*(s-b)*(s-c)) mit s=(a+b+c)/2"
      24. davor = a ^ 2 + b ^ 2
      25. danach = 2 * Wurzel(a ^ 2 * b ^ 2 - 4 * F ^ 2, "a,b,F")
      26. If davor - danach < 0 Or danach = 0 Then SeiteC = Wurzel(davor + danach, "a,b,F") Else Formeln = Formeln & vbCrLf & " c--"
      27. ElseIf a1 And b1 And c1 And (Not F1) Then
      28. Formeln = Formeln & vbCrLf & "F=Sqr(s*(s-a)*(s-b)*(s-c)) mit s=(a+b+c)/2"
      29. s = (a + b + c) / 2
      30. Flächeninhalt = Wurzel(s * (s - a) * (s - b) * (s - c), "a,b,c")
      31. End If
      33. End Sub
      36. Private Sub Kosinussatz(Winkel As drWinkel)
      37. 'Berechnet fehlende Werte aufgrund des Kosinussatzes, sofern möglich.
      39. Dim davor As Double, danach As Double
      41. Select Case Winkel
      42. Case drAlpha
      43. If (Not a1) And b1 And c1 And alpha1 Then
      44. Formeln = Formeln & vbCrLf & "a²=b²+c²-2bc*cos(alpha)"
      45. SeiteA = Wurzel(b ^ 2 + c ^ 2 - 2 * b * c * Cos(alpha), "b,c,alpha")
      46. ElseIf a1 And (Not b1) And c1 And alpha1 Then
      47. Formeln = Formeln & vbCrLf & "a²=b²+c²-2bc*cos(alpha)"
      48. davor = c * Cos(alpha)
      49. danach = Wurzel(c ^ 2 * (Cos(alpha) ^ 2 - 1) + a ^ 2, "c,alpha,a")
      50. If davor - danach < 0 Or danach = 0 Then SeiteB = davor + danach Else Formeln = Formeln & vbCrLf & " b--"
      51. ElseIf a1 And b1 And (Not c1) And alpha1 Then
      52. Formeln = Formeln & vbCrLf & "a²=b²+c²-2bc*cos(alpha)"
      53. davor = b * Cos(alpha)
      54. danach = Wurzel(b ^ 2 * (Cos(alpha) ^ 2 - 1) + a ^ 2, "b,alpha,a")
      55. If davor - danach < 0 Or danach = 0 Then SeiteC = davor + danach Else Formeln = Formeln & vbCrLf & " c--"
      56. ElseIf a1 And b1 And c1 And (Not alpha1) Then
      57. Formeln = Formeln & vbCrLf & "a²=b²+c²-2bc*cos(alpha)"
      58. WinkelAlpha = ArcCos((-a ^ 2 + b ^ 2 + c ^ 2) / (2 * b * c), "a,b,c")
      59. End If
      60. Case drBeta
      61. If (Not a1) And b1 And c1 And beta1 Then
      62. Formeln = Formeln & vbCrLf & "b²=a²+c²-2ac*cos(beta)"
      63. davor = c * Cos(beta)
      64. danach = Wurzel(c ^ 2 * (Cos(beta) ^ 2 - 1) + b ^ 2, "c,beta,b")
      65. If davor - danach < 0 Or danach = 0 Then SeiteA = davor + danach Else Formeln = Formeln & vbCrLf & " a--"
      66. ElseIf a1 And (Not b1) And c1 And beta1 Then
      67. Formeln = Formeln & vbCrLf & "b²=a²+c²-2ac*cos(beta)"
      68. SeiteB = Wurzel(a ^ 2 + c ^ 2 - 2 * a * c * Cos(beta), "a,c,beta")
      69. ElseIf a1 And b1 And (Not c1) And beta1 Then
      70. Formeln = Formeln & vbCrLf & "b²=a²+c²-2ac*cos(beta)"
      71. davor = a * Cos(beta)
      72. danach = Wurzel(a ^ 2 * (Cos(beta) ^ 2 - 1) + b ^ 2, "a,beta,b")
      73. If davor - danach < 0 Or danach = 0 Then SeiteC = davor + danach Else Formeln = Formeln & vbCrLf & " c--"
      74. ElseIf a1 And b1 And c1 And (Not beta1) Then
      75. Formeln = Formeln & vbCrLf & "b²=a²+c²-2ac*cos(beta)"
      76. WinkelBeta = ArcCos((a ^ 2 - b ^ 2 + c ^ 2) / (2 * a * c), "a,b,c")
      77. End If
      78. Case drGamma
      79. If (Not a1) And b1 And c1 And gamma1 Then
      80. Formeln = Formeln & vbCrLf & "c²=a²+b²-2ab*cos(gamma)"
      81. davor = b * Cos(gamma)
      82. danach = Wurzel(b ^ 2 * (Cos(gamma) ^ 2 - 1) + c ^ 2, "b,gamma,c")
      83. If davor - danach < 0 Or danach = 0 Then SeiteA = davor + danach Else Formeln = Formeln & vbCrLf & " a--"
      84. ElseIf a1 And (Not b1) And c1 And gamma1 Then
      85. Formeln = Formeln & vbCrLf & "c²=a²+b²-2ab*cos(gamma)"
      86. davor = a * Cos(gamma)
      87. danach = Wurzel(a ^ 2 * (Cos(gamma) ^ 2 - 1) + c ^ 2, "a,gamma,c")
      88. If davor - danach < 0 Or danach = 0 Then SeiteB = davor + danach Else Formeln = Formeln & vbCrLf & " b--"
      89. ElseIf a1 And b1 And (Not c1) And gamma1 Then
      90. Formeln = Formeln & vbCrLf & "c²=a²+b²-2ab*cos(gamma)"
      91. SeiteC = Wurzel(a ^ 2 + b ^ 2 - 2 * a * b * Cos(gamma), "a,b,gamma")
      92. ElseIf a1 And b1 And c1 And (Not gamma1) Then
      93. Formeln = Formeln & vbCrLf & "c²=a²+b²-2ab*cos(gamma)"
      94. WinkelGamma = ArcCos((a ^ 2 + b ^ 2 - c ^ 2) / (2 * a * b), "a,b,c")
      95. End If
      96. End Select
      98. End Sub

      Visual Basic-Quellcode

      1. Private Sub Inkreis()
      2. 'Berechnet den Inkreisradius aufgrund von a, b und c.
      4. Dim s As Double, alt As Double, neu As Double
      5. Dim kr As Double, ks As Double, kt As Double, kp As Double, kq As Double, Radikand As Double
      7. If a1 And b1 And c1 And rho1 Then
      8. alt = rho
      9. s = (a + b + c) / 2
      10. neu = Wurzel((s - a) * (s - b) * (s - c) / s, "a,b,c")
      11. If Abs(neu - alt) > 10 ^ -6 Then Fehlermeldung drUnmöglich, "rho,a,b,c"
      12. ElseIf (Not a1) And b1 And c1 And rho1 Then
      13. Formeln = Formeln & vbCrLf & "rho=Sqr((s-a)*(s-b)*(s-c)/s) mit s=(a+b+c)/2"
      14. kr = -(b + c)
      15. ks = 4 * rho ^ 2 - (b - c) ^ 2
      16. kt = (b + c) * (4 * rho ^ 2 + (b - c) ^ 2)
      17. kp = ks - kr ^ 2 / 3
      18. kq = 2 * kr ^ 3 / 27 - ks * kr / 3 + kt
      19. Radikand = (kq / 2) ^ 2 + (kp / 3) ^ 3
      20. If Radikand >= 0 Then SeiteA = Wurzel3(-kq / 2 + Wurzel(Radikand, "b,c")) + Wurzel3(-kq / 2 - Wurzel(Radikand, "b,c")) Else Formeln = Formeln & vbCrLf & " a---"
      21. ElseIf a1 And (Not b1) And c1 And rho1 Then
      22. Formeln = Formeln & vbCrLf & "rho=Sqr((s-a)*(s-b)*(s-c)/s) mit s=(a+b+c)/2"
      23. kr = -(a + c)
      24. ks = 4 * rho ^ 2 - (a - c) ^ 2
      25. kt = (a + c) * (4 * rho ^ 2 + (a - c) ^ 2)
      26. kp = ks - kr ^ 2 / 3
      27. kq = 2 * kr ^ 3 / 27 - ks * kr / 3 + kt
      28. Radikand = (kq / 2) ^ 2 + (kp / 3) ^ 3
      29. If Radikand >= 0 Then SeiteB = Wurzel3(-kq / 2 + Wurzel(Radikand, "a,c")) + Wurzel3(-kq / 2 - Wurzel(Radikand, "a,c")) Else Formeln = Formeln & vbCrLf & " b---"
      30. ElseIf a1 And b1 And (Not c1) And rho1 Then
      31. Formeln = Formeln & vbCrLf & "rho=Sqr((s-a)*(s-b)*(s-c)/s) mit s=(a+b+c)/2"
      32. kr = -(a + b)
      33. ks = 4 * rho ^ 2 - (a - b) ^ 2
      34. kt = (a + b) * (4 * rho ^ 2 + (a - b) ^ 2)
      35. kp = ks - kr ^ 2 / 3
      36. kq = 2 * kr ^ 3 / 27 - ks * kr / 3 + kt
      37. Radikand = (kq / 2) ^ 2 + (kp / 3) ^ 3
      38. If Radikand >= 0 Then SeiteC = Wurzel3(-kq / 2 + Wurzel(Radikand, "a,b")) + Wurzel3(-kq / 2 - Wurzel(Radikand, "a,c")) Else Formeln = Formeln & vbCrLf & " c---"
      39. ElseIf a1 And b1 And c1 And (Not rho1) Then
      40. Formeln = Formeln & vbCrLf & "rho=Sqr((s-a)*(s-b)*(s-c)/s) mit s=(a+b+c)/2"
      41. s = (a + b + c) / 2
      42. Inkreisradius = Wurzel((s - a) * (s - b) * (s - c) / s, "a,b,c")
      43. End If
      45. End Sub



      Die Ein- und Ausgabe der Werte steuere ich über Properties:

      Visual Basic-Quellcode

      1. Public Property Get SeiteA() As Double
      3. If Not a1 Then Fehlermeldung drKeinWert, "SeiteA"
      4. SeiteA = a
      6. End Property
      9. Public Property Let SeiteA(Wert As Double)
      11. Formeln = Formeln & vbCrLf & " a=" & Wert
      12. If a1 Then Fehlermeldung drBereitsBestimmt, "SeiteA", a
      13. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "SeiteA", Wert
      14. a = Wert
      15. a1 = True
      17. Umfangformel
      18. Teilstrecken drA
      19. Fläche drA
      20. Umkreis drHb
      21. Umkreis drHc
      22. SinFormel drA, drHb
      23. SinFormel drA, drHc
      24. CosFormel drA, drBeta
      25. CosFormel drA, drGamma
      26. Pythagoras drA, drHb
      27. Pythagoras drA, drHc
      28. FlächeABC
      29. Kosinussatz drAlpha
      30. Kosinussatz drBeta
      31. Kosinussatz drGamma
      32. Inkreis
      34. End Property
      37. Public Property Get SeiteB() As Double
      39. If Not b1 Then Fehlermeldung drKeinWert, "SeiteB"
      40. SeiteB = b
      42. End Property
      45. Public Property Let SeiteB(Wert As Double)
      47. Formeln = Formeln & vbCrLf & " b=" & Wert
      48. If b1 Then Fehlermeldung drBereitsBestimmt, "SeiteB", b
      49. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "SeiteB", Wert
      50. b = Wert
      51. b1 = True
      53. Umfangformel
      54. Teilstrecken drB
      55. Fläche drB
      56. Umkreis drHa
      57. Umkreis drHc
      58. SinFormel drB, drHa
      59. SinFormel drB, drHc
      60. CosFormel drB, drAlpha
      61. CosFormel drB, drGamma
      62. Pythagoras drB, drHa
      63. Pythagoras drB, drHc
      64. FlächeABC
      65. Kosinussatz drAlpha
      66. Kosinussatz drBeta
      67. Kosinussatz drGamma
      68. Inkreis
      70. End Property
      73. Public Property Get SeiteC() As Double
      75. If Not c1 Then Fehlermeldung drKeinWert, "SeiteC"
      76. SeiteC = c
      78. End Property
      81. Public Property Let SeiteC(Wert As Double)
      83. Formeln = Formeln & vbCrLf & " c=" & Wert
      84. If c1 Then Fehlermeldung drBereitsBestimmt, "SeiteC", c
      85. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "SeiteC", Wert
      86. c = Wert
      87. c1 = True
      89. Umfangformel
      90. Teilstrecken drC
      91. Fläche drC
      92. Umkreis drHa
      93. Umkreis drHb
      94. SinFormel drC, drHa
      95. SinFormel drC, drHb
      96. CosFormel drC, drAlpha
      97. CosFormel drC, drBeta
      98. Pythagoras drC, drHa
      99. Pythagoras drC, drHb
      100. FlächeABC
      101. Kosinussatz drAlpha
      102. Kosinussatz drBeta
      103. Kosinussatz drGamma
      104. Inkreis
      106. End Property

      Bei den Winkeln bedeutet die Variante mit ° Angabe im Gradmaß, bei der Variante ohne ° Angabe im Bogenmaß

      Visual Basic-Quellcode

      1. Public Property Get WinkelAlpha() As Double
      3. If Not alpha1 Then Fehlermeldung drKeinWert, "WinkelAlpha"
      4. WinkelAlpha = alpha
      6. End Property
      9. Public Property Let WinkelAlpha(Wert As Double)
      11. Formeln = Formeln & vbCrLf & " alpha=" & Wert / pi * 180 & "°"
      12. If alpha1 Then Fehlermeldung drBereitsBestimmt, "WinkelAlpha", alpha
      13. If Wert <= 0 Or Wert >= pi Then Fehlermeldung drWinkelbereich, "WinkelAlpha", Wert
      14. alpha = Wert
      15. alpha1 = True
      17. Winkelsumme
      18. SinFormel drB, drHc
      19. SinFormel drC, drHb
      20. CosFormel drB, drAlpha
      21. CosFormel drC, drAlpha
      22. Kosinussatz drAlpha
      24. End Property
      27. Public Property Get WinkelAlpha°() As Double
      29. WinkelAlpha° = WinkelAlpha / pi * 180
      31. End Property
      34. Public Property Let WinkelAlpha°(Wert As Double)
      36. WinkelAlpha = Wert / 180 * pi
      38. End Property
      41. Public Property Get WinkelBeta() As Double
      43. If Not beta1 Then Fehlermeldung drKeinWert, "WinkelBeta"
      44. WinkelBeta = beta
      46. End Property
      49. Public Property Let WinkelBeta(Wert As Double)
      51. Formeln = Formeln & vbCrLf & " beta=" & Wert / pi * 180 & "°"
      52. If beta1 Then Fehlermeldung drBereitsBestimmt, "WinkelBeta", beta
      53. If Wert <= 0 Or Wert >= pi Then Fehlermeldung drWinkelbereich, "WinkelBeta", Wert
      54. beta = Wert
      55. beta1 = True
      57. Winkelsumme
      58. SinFormel drA, drHc
      59. SinFormel drC, drHa
      60. CosFormel drA, drBeta
      61. CosFormel drC, drBeta
      62. Kosinussatz drBeta
      64. End Property
      67. Public Property Get WinkelBeta°() As Double
      69. WinkelBeta° = WinkelBeta / pi * 180
      71. End Property
      74. Public Property Let WinkelBeta°(Wert As Double)
      76. WinkelBeta = Wert / 180 * pi
      78. End Property
      81. Public Property Get WinkelGamma() As Double
      83. If Not gamma1 Then Fehlermeldung drKeinWert, "WinkelGamma"
      84. WinkelGamma = gamma
      86. End Property
      89. Public Property Let WinkelGamma(Wert As Double)
      91. Formeln = Formeln & vbCrLf & " gamma=" & Wert / pi * 180 & "°"
      92. If gamma1 Then Fehlermeldung drBereitsBestimmt, "WinkelGamma", gamma
      93. If Wert <= 0 Or Wert >= pi Then Fehlermeldung drWinkelbereich, "WinkelGamma", Wert
      94. gamma = Wert
      95. gamma1 = True
      97. Winkelsumme
      98. SinFormel drA, drHb
      99. SinFormel drB, drHa
      100. CosFormel drA, drGamma
      101. CosFormel drB, drGamma
      102. Kosinussatz drGamma
      104. End Property
      107. Public Property Get WinkelGamma°() As Double
      109. WinkelGamma° = WinkelGamma / pi * 180
      111. End Property
      114. Public Property Let WinkelGamma°(Wert As Double)
      116. WinkelGamma = Wert / 180 * pi
      118. End Property

      Visual Basic-Quellcode

      1. Public Property Get HöheHa() As Double
      3. If Not ha1 Then Fehlermeldung drKeinWert, "HöheHa"
      4. HöheHa = ha
      6. End Property
      9. Public Property Let HöheHa(Wert As Double)
      11. Formeln = Formeln & vbCrLf & " ha=" & Wert
      12. If ha1 Then Fehlermeldung drBereitsBestimmt, "HöheHa", ha
      13. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "HöheHa", Wert
      14. ha = Wert
      15. ha1 = True
      17. Fläche drA
      18. Umkreis drHa
      19. SinFormel drB, drHa
      20. SinFormel drC, drHa
      21. Pythagoras drB, drHa
      22. Pythagoras drC, drHa
      24. End Property
      27. Public Property Get HöheHb() As Double
      29. If Not hb1 Then Fehlermeldung drKeinWert, "HöheHb"
      30. HöheHb = hb
      32. End Property
      35. Public Property Let HöheHb(Wert As Double)
      37. Formeln = Formeln & vbCrLf & " hb=" & Wert
      38. If hb1 Then Fehlermeldung drBereitsBestimmt, "HöheHb", hb
      39. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "HöheHb", Wert
      40. hb = Wert
      41. hb1 = True
      43. Fläche drB
      44. Umkreis drHb
      45. SinFormel drA, drHb
      46. SinFormel drC, drHb
      47. Pythagoras drA, drHb
      48. Pythagoras drC, drHb
      50. End Property
      53. Public Property Get HöheHc() As Double
      55. If Not hc1 Then Fehlermeldung drKeinWert, "HöheHc"
      56. HöheHc = hc
      58. End Property
      61. Public Property Let HöheHc(Wert As Double)
      63. Formeln = Formeln & vbCrLf & " hc=" & Wert
      64. If hc1 Then Fehlermeldung drBereitsBestimmt, "HöheHc", hc
      65. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "HöheHc", Wert
      66. hc = Wert
      67. hc1 = True
      69. Fläche drC
      70. Umkreis drHc
      71. SinFormel drA, drHc
      72. SinFormel drB, drHc
      73. Pythagoras drA, drHc
      74. Pythagoras drB, drHc
      76. End Property

      Visual Basic-Quellcode

      1. Public Property Get Umfang() As Double
      3. If Not U1 Then Fehlermeldung drKeinWert, "Umfang"
      4. Umfang = U
      6. End Property
      9. Public Property Let Umfang(Wert As Double)
      11. Formeln = Formeln & vbCrLf & " U=" & Wert
      12. If U1 Then Fehlermeldung drBereitsBestimmt, "Umfang", U
      13. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "Umfang", Wert
      14. U = Wert
      15. U1 = True
      17. Umfangformel
      19. End Property
      22. Public Property Get Flächeninhalt() As Double
      24. If Not F1 Then Fehlermeldung drKeinWert, "Flächeninhalt"
      25. Flächeninhalt = F
      27. End Property
      30. Public Property Let Flächeninhalt(Wert As Double)
      32. Formeln = Formeln & vbCrLf & " F=" & Wert
      33. If F1 Then Fehlermeldung drBereitsBestimmt, "Flächeninhalt", F
      34. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "Flächeninhalt", Wert
      35. F = Wert
      36. F1 = True
      38. Fläche drA
      39. Fläche drB
      40. Fläche drC
      41. FlächeABC
      43. End Property
      46. Public Property Get Inkreisradius() As Double
      48. If Not rho1 Then Fehlermeldung drKeinWert, "Inkreisradius"
      49. Inkreisradius = rho
      51. End Property
      54. Public Property Let Inkreisradius(Wert As Double)
      56. Formeln = Formeln & vbCrLf & " rho=" & Wert
      57. If rho1 Then Fehlermeldung drBereitsBestimmt, "Inkreisradius", rho
      58. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "Inkreisradius", Wert
      59. rho = Wert
      60. rho1 = True
      62. Inkreis
      64. End Property
      67. Public Property Get Umkreisradius() As Double
      69. If Not r1 Then Fehlermeldung drKeinWert, "Umkreisradius"
      70. Umkreisradius = r
      72. End Property
      75. Public Property Let Umkreisradius(Wert As Double)
      77. Formeln = Formeln & vbCrLf & " r=" & Wert
      78. If r1 Then Fehlermeldung drBereitsBestimmt, "Umkreisradius", r
      79. If Wert <= 0 Then Fehlermeldung drZahlenbereich, "Umkreisradius", Wert
      80. r = Wert
      81. r1 = True
      83. Umkreis drHa
      84. Umkreis drHb
      85. Umkreis drHc
      87. End Property

      Visual Basic-Quellcode

      1. Public Property Get StreckePa() As Double
      3. If Not pa1 Then Fehlermeldung drKeinWert, "StreckePa"
      4. StreckePa = pa
      6. End Property
      9. Public Property Let StreckePa(Wert As Double)
      11. Formeln = Formeln & vbCrLf & " pa=" & Wert
      12. If pa1 Then Fehlermeldung drBereitsBestimmt, "StreckePa", pa
      13. pa = Wert
      14. pa1 = True
      16. Teilstrecken drA
      17. CosFormel drC, drBeta
      18. Pythagoras drC, drHa
      20. End Property
      23. Public Property Get StreckePb() As Double
      25. If Not pb1 Then Fehlermeldung drKeinWert, "StreckePb"
      26. StreckePb = pb
      28. End Property
      31. Public Property Let StreckePb(Wert As Double)
      33. Formeln = Formeln & vbCrLf & " pb=" & Wert
      34. If pb1 Then Fehlermeldung drBereitsBestimmt, "StreckePb", pb
      35. pb = Wert
      36. pb1 = True
      38. Teilstrecken drB
      39. CosFormel drA, drGamma
      40. Pythagoras drA, drHb
      42. End Property
      45. Public Property Get StreckePc() As Double
      47. If Not pc1 Then Fehlermeldung drKeinWert, "StreckePc"
      48. StreckePc = pc
      50. End Property
      53. Public Property Let StreckePc(Wert As Double)
      55. Formeln = Formeln & vbCrLf & " pc=" & Wert
      56. If pc1 Then Fehlermeldung drBereitsBestimmt, "StreckePc", pc
      57. pc = Wert
      58. pc1 = True
      60. Teilstrecken drC
      61. CosFormel drB, drAlpha
      62. Pythagoras drB, drHc
      64. End Property
      67. Public Property Get StreckeQa() As Double
      69. If Not qa1 Then Fehlermeldung drKeinWert, "StreckeQa"
      70. StreckeQa = qa
      72. End Property
      75. Public Property Let StreckeQa(Wert As Double)
      77. Formeln = Formeln & vbCrLf & " qa=" & Wert
      78. If qa1 Then Fehlermeldung drBereitsBestimmt, "StreckeQa", qa
      79. qa = Wert
      80. qa1 = True
      82. Teilstrecken drA
      83. CosFormel drB, drGamma
      84. Pythagoras drB, drHa
      86. End Property
      89. Public Property Get StreckeQb() As Double
      91. If Not qb1 Then Fehlermeldung drKeinWert, "StreckeQb"
      92. StreckeQb = qb
      94. End Property
      97. Public Property Let StreckeQb(Wert As Double)
      99. Formeln = Formeln & vbCrLf & " qb=" & Wert
      100. If qb1 Then Fehlermeldung drBereitsBestimmt, "StreckeQb", qb
      101. qb = Wert
      102. qb1 = True
      104. Teilstrecken drB
      105. CosFormel drC, drAlpha
      106. Pythagoras drC, drHb
      108. End Property
      111. Public Property Get StreckeQc() As Double
      113. If Not qc1 Then Fehlermeldung drKeinWert, "StreckeQc"
      114. StreckeQc = qc
      116. End Property
      119. Public Property Let StreckeQc(Wert As Double)
      121. Formeln = Formeln & vbCrLf & " qc=" & Wert
      122. If qc1 Then Fehlermeldung drBereitsBestimmt, "StreckeQc", qc
      123. qc = Wert
      124. qc1 = True
      126. Teilstrecken drC
      127. CosFormel drA, drBeta
      128. Pythagoras drA, drHc
      130. End Property

      Hier sind noch Funktionen und Prozeduren zur Auswertung der Werte.

      Visual Basic-Quellcode

      1. Public Function alleWerte() As Boolean
      2. 'gibt zurück, ob alle Werte bestimmt sind.
      4. alleWerte = (a1 And b1 And c1 And alpha1 And beta1 And gamma1 And ha1 And hb1 And hc1 And U1 And F1 And rho1 And r1 And pa1 And pb1 And pc1 And qa1 And qb1 And qc1)
      6. End Function
      9. Public Function AnzahlWerte() As Integer
      10. 'gibt zurück, wieviele Werte bestimmt sind.
      12. AnzahlWerte = -a1 - b1 - c1 - alpha1 - beta1 - gamma1 - ha1 - hb1 - hc1 - U1 - F1 - rho1 - r1 - pa1 - pb1 - pc1 - qa1 - qb1 - qc1
      14. End Function



      Visual Basic-Quellcode

      1. Public Function Werteliste(Optional Nachkommastellen As Integer = -1) As String
      2. 'gibt einen String zurück, in dem alle Werte aufgelistet sind.
      3. 'Ist "Nachkommastellen" = -1, wird das Standard-Zahlenformat verwendet.
      5. Dim zFormat As String, Quadrateinheit As String, n As Integer
      7. Select Case Sgn(Nachkommastellen)
      8. Case -1: zFormat = ""
      9. Case 0: zFormat = "#,##0"
      10. Case 1: zFormat = "#,##0." & String(Nachkommastellen, "0")
      11. End Select
      12. If Längeneinheit = "" Then Quadrateinheit = "" Else Quadrateinheit = Längeneinheit & "²"
      13. n = AnzahlWerte
      14. Werteliste = n & IIf(alleWerte, " (alle)", "") & IIf((n = 1), " Wert ist bestimmt:", " Werte sind bestimmt:") & vbCrLf
      15. Werteliste = Werteliste & vbCrLf & "a" & vbTab & IIf(a1, Format(a, zFormat) & " " & Längeneinheit, "n/a")
      16. Werteliste = Werteliste & vbCrLf & "b" & vbTab & IIf(b1, Format(b, zFormat) & " " & Längeneinheit, "n/a")
      17. Werteliste = Werteliste & vbCrLf & "c" & vbTab & IIf(c1, Format(c, zFormat) & " " & Längeneinheit, "n/a") & vbCrLf
      18. Werteliste = Werteliste & vbCrLf & "alpha" & vbTab & IIf(alpha1, Format(alpha / pi * 180, zFormat) & "°", "n/a")
      19. Werteliste = Werteliste & vbCrLf & "beta" & vbTab & IIf(beta1, Format(beta / pi * 180, zFormat) & "°", "n/a")
      20. Werteliste = Werteliste & vbCrLf & "gamma" & vbTab & IIf(gamma1, Format(gamma / pi * 180, zFormat) & "°", "n/a") & vbCrLf
      21. Werteliste = Werteliste & vbCrLf & "ha" & vbTab & IIf(ha1, Format(ha, zFormat) & " " & Längeneinheit, "n/a")
      22. Werteliste = Werteliste & vbCrLf & "hb" & vbTab & IIf(hb1, Format(hb, zFormat) & " " & Längeneinheit, "n/a")
      23. Werteliste = Werteliste & vbCrLf & "hc" & vbTab & IIf(hc1, Format(hc, zFormat) & " " & Längeneinheit, "n/a") & vbCrLf
      24. Werteliste = Werteliste & vbCrLf & "U" & vbTab & IIf(U1, Format(U, zFormat) & " " & Längeneinheit, "n/a")
      25. Werteliste = Werteliste & vbCrLf & "F" & vbTab & IIf(F1, Format(F, zFormat) & " " & Quadrateinheit, "n/a") & vbCrLf
      26. Werteliste = Werteliste & vbCrLf & "rho" & vbTab & IIf(rho1, Format(rho, zFormat) & " " & Längeneinheit, "n/a")
      27. Werteliste = Werteliste & vbCrLf & "r" & vbTab & IIf(r1, Format(r, zFormat) & " " & Längeneinheit, "n/a") & vbCrLf
      28. Werteliste = Werteliste & vbCrLf & "pa" & vbTab & IIf(pa1, Format(pa, zFormat) & " " & Längeneinheit, "n/a")
      29. Werteliste = Werteliste & vbCrLf & "qa" & vbTab & IIf(qa1, Format(qa, zFormat) & " " & Längeneinheit, "n/a") & vbCrLf
      30. Werteliste = Werteliste & vbCrLf & "pb" & vbTab & IIf(pb1, Format(pb, zFormat) & " " & Längeneinheit, "n/a")
      31. Werteliste = Werteliste & vbCrLf & "qb" & vbTab & IIf(qb1, Format(qb, zFormat) & " " & Längeneinheit, "n/a") & vbCrLf
      32. Werteliste = Werteliste & vbCrLf & "pc" & vbTab & IIf(pc1, Format(pc, zFormat) & " " & Längeneinheit, "n/a")
      33. Werteliste = Werteliste & vbCrLf & "qc" & vbTab & IIf(qc1, Format(qc, zFormat) & " " & Längeneinheit, "n/a")
      35. End Function
      38. Public Function WertelisteKurz(Optional Werte As String = "a,b,c,alpha,beta,gamma,ha,hb,hc,F,U,rho,r,pa,pb,pc,qa,qb,qc") As String
      39. 'gibt einen String zurück, in dem nur die Werte aufgelistet sind, die bestimmt sind, durch Semikolon (;) getrennt.
      41. Dim Liste As String
      43. Liste = "," & Werte & ","
      44. If a1 And InStr(1, Liste, ",a,") > 0 Then WertelisteKurz = WertelisteKurz & "; a=" & a
      45. If b1 And InStr(1, Liste, ",b,") > 0 Then WertelisteKurz = WertelisteKurz & "; b=" & b
      46. If c1 And InStr(1, Liste, ",c,") > 0 Then WertelisteKurz = WertelisteKurz & "; c=" & c
      47. If alpha1 And InStr(1, Liste, ",alpha,") > 0 Then WertelisteKurz = WertelisteKurz & "; alpha=" & alpha / pi * 180 & "°"
      48. If beta1 And InStr(1, Liste, ",beta,") > 0 Then WertelisteKurz = WertelisteKurz & "; beta=" & beta / pi * 180 & "°"
      49. If gamma1 And InStr(1, Liste, ",gamma,") > 0 Then WertelisteKurz = WertelisteKurz & "; gamma=" & gamma / pi * 180 & "°"
      50. If ha1 And InStr(1, Liste, ",ha,") > 0 Then WertelisteKurz = WertelisteKurz & "; ha=" & ha
      51. If hb1 And InStr(1, Liste, ",hb,") > 0 Then WertelisteKurz = WertelisteKurz & "; hb=" & hb
      52. If hc1 And InStr(1, Liste, ",hc,") > 0 Then WertelisteKurz = WertelisteKurz & "; hc=" & hc
      53. If U1 And InStr(1, Liste, ",U,") > 0 Then WertelisteKurz = WertelisteKurz & "; U=" & U
      54. If F1 And InStr(1, Liste, ",F,") > 0 Then WertelisteKurz = WertelisteKurz & "; F=" & F
      55. If rho1 And InStr(1, Liste, ",rho,") > 0 Then WertelisteKurz = WertelisteKurz & "; rho=" & rho
      56. If r1 And InStr(1, Liste, ",r,") > 0 Then WertelisteKurz = WertelisteKurz & "; r=" & r
      57. If pa1 And InStr(1, Liste, ",pa,") > 0 Then WertelisteKurz = WertelisteKurz & "; pa=" & pa
      58. If qa1 And InStr(1, Liste, ",qa,") > 0 Then WertelisteKurz = WertelisteKurz & "; qa=" & qa
      59. If pb1 And InStr(1, Liste, ",pb,") > 0 Then WertelisteKurz = WertelisteKurz & "; pb=" & pb
      60. If qb1 And InStr(1, Liste, ",qb,") > 0 Then WertelisteKurz = WertelisteKurz & "; qb=" & qb
      61. If pc1 And InStr(1, Liste, ",pc,") > 0 Then WertelisteKurz = WertelisteKurz & "; pc=" & pc
      62. If qc1 And InStr(1, Liste, ",qc,") > 0 Then WertelisteKurz = WertelisteKurz & "; qc=" & qc
      63. If WertelisteKurz <> "" Then WertelisteKurz = Mid(WertelisteKurz, 3)
      65. End Function
      68. Public Function Rechenweg() As String
      69. 'liefert einen String, der die Formeln und Wertzuweisungen, die angewendet wurden, auflistet.
      71. If Formeln = "" Then
      72. Rechenweg = "keine Rechenschritte"
      73. Else
      74. Rechenweg = "Rechenschritte:" & vbCrLf & Replace(Replace(Formeln, "---", "=? (3 Lösungen)"), "--", "=? (2 Lösungen)")
      75. End If
      77. End Function

      Zum Schluss noch die Plausi-Prüfung:

      Quellcode

      1. Public Sub PlausiPrüfung()
      2. 'prüft, ob alle Formeln stimmen, wenn alle Werte bestimmt sind.
      4. Dim Plausi As String, Diff As Double, gesDiff As Double, s As Double, Meldung As VbMsgBoxStyle
      6. If alleWerte Then
      7. Plausi = "Plausibilitäts-Prüfung:" & vbCrLf & vbCrLf & "(Differenz = rechte Seite - linke Seite)" & vbCrLf
      8. gesDiff = 0
      9. s = (a + b + c) / 2
      10. Diff = a + b + c - U
      11. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "U=a+b+c"
      12. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      13. gesDiff = gesDiff + Abs(Diff)
      14. Diff = pa + qa - a
      15. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "a=pa+qa"
      16. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      17. gesDiff = gesDiff + Abs(Diff)
      18. Diff = pb + qb - b
      19. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "b=pb+qb"
      20. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      21. gesDiff = gesDiff + Abs(Diff)
      22. Diff = pc + qc - c
      23. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "c=pc+qc"
      24. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      25. gesDiff = gesDiff + Abs(Diff)
      26. Diff = (pi - alpha - beta - gamma) / pi * 180
      27. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "alpha+beta+gamma=180°"
      28. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff & "°"
      29. gesDiff = gesDiff + Abs(Diff)
      30. Diff = a * ha / 2 - F
      31. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "F=a*ha/2"
      32. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      33. gesDiff = gesDiff + Abs(Diff)
      34. Diff = b * hb / 2 - F
      35. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "F=b*hb/2"
      36. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      37. gesDiff = gesDiff + Abs(Diff)
      38. Diff = c * hc / 2 - F
      39. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "F=c*hc/2"
      40. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      41. gesDiff = gesDiff + Abs(Diff)
      42. Diff = b * c / (2 * ha) - r
      43. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "r=bc/2ha"
      44. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      45. gesDiff = gesDiff + Abs(Diff)
      46. Diff = a * c / (2 * hb) - r
      47. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "r=ac/2hb"
      48. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      49. gesDiff = gesDiff + Abs(Diff)
      50. Diff = a * b / (2 * hc) - r
      51. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "r=ab/2hc"
      52. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      53. gesDiff = gesDiff + Abs(Diff)
      54. Diff = a * Sin(gamma) - hb
      55. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "hb=a*sin(gamma)"
      56. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      57. gesDiff = gesDiff + Abs(Diff)
      58. Diff = a * Sin(beta) - hc
      59. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "hc=a*sin(beta)"
      60. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      61. gesDiff = gesDiff + Abs(Diff)
      62. Diff = b * Sin(gamma) - ha
      63. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "ha=b*sin(gamma)"
      64. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      65. gesDiff = gesDiff + Abs(Diff)
      66. Diff = b * Sin(alpha) - hc
      67. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "hc=b*sin(alpha)"
      68. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      69. gesDiff = gesDiff + Abs(Diff)
      70. Diff = c * Sin(beta) - ha
      71. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "ha=c*sin(beta)"
      72. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      73. gesDiff = gesDiff + Abs(Diff)
      74. Diff = c * Sin(alpha) - hb
      75. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "hb=c*sin(alpha)"
      76. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      77. gesDiff = gesDiff + Abs(Diff)
      78. Diff = a * Cos(beta) - qc
      79. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "qc=a*cos(beta)"
      80. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      81. gesDiff = gesDiff + Abs(Diff)
      82. Diff = a * Cos(gamma) - pb
      83. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "pb=a*cos(gamma)"
      84. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      85. gesDiff = gesDiff + Abs(Diff)
      86. Diff = b * Cos(alpha) - pc
      87. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "pc=b*cos(alpha)"
      88. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      89. gesDiff = gesDiff + Abs(Diff)
      90. Diff = b * Cos(gamma) - qa
      91. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "qa=b*cos(gamma)"
      92. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      93. gesDiff = gesDiff + Abs(Diff)
      94. Diff = c * Cos(alpha) - qb
      95. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "qb=c*cos(alpha)"
      96. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      97. gesDiff = gesDiff + Abs(Diff)
      98. Diff = c * Cos(beta) - pa
      99. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "pa=c*cos(beta)"
      100. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      101. gesDiff = gesDiff + Abs(Diff)
      102. Diff = a ^ 2 - pb ^ 2 - hb ^ 2
      103. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "pb²+hb²=a²"
      104. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      105. gesDiff = gesDiff + Abs(Diff)
      106. Diff = a ^ 2 - qc ^ 2 - hc ^ 2
      107. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "qc²+hc²=a²"
      108. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      109. gesDiff = gesDiff + Abs(Diff)
      110. Diff = b ^ 2 - qa ^ 2 - ha ^ 2
      111. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "qa²+ha²=b²"
      112. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      113. gesDiff = gesDiff + Abs(Diff)
      114. Diff = b ^ 2 - pc ^ 2 - hc ^ 2
      115. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "pc²+hc²=b²"
      116. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      117. gesDiff = gesDiff + Abs(Diff)
      118. Diff = c ^ 2 - pa ^ 2 - ha ^ 2
      119. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "pa²+ha²=c²"
      120. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      121. gesDiff = gesDiff + Abs(Diff)
      122. Diff = c ^ 2 - qb ^ 2 - hb ^ 2
      123. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "qb²+hb²=c²"
      124. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      125. gesDiff = gesDiff + Abs(Diff)
      126. Diff = Sqr(s * (s - a) * (s - b) * (s - c)) - F
      127. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "F=Sqr(s*(s-a)*(s-b)*(s-c)) mit s=(a+b+c)/2"
      128. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      129. gesDiff = gesDiff + Abs(Diff)
      130. Diff = b ^ 2 + c ^ 2 - 2 * b * c * Cos(alpha) - a ^ 2
      131. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "a²=b²+c²-2bc*cos(alpha)"
      132. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      133. gesDiff = gesDiff + Abs(Diff)
      134. Diff = a ^ 2 + c ^ 2 - 2 * a * c * Cos(beta) - b ^ 2
      135. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "b²=a²+c²-2ac*cos(beta)"
      136. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      137. gesDiff = gesDiff + Abs(Diff)
      138. Diff = a ^ 2 + b ^ 2 - 2 * a * b * Cos(gamma) - c ^ 2
      139. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "c²=a²+b²-2ab*cos(gamma)"
      140. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      141. gesDiff = gesDiff + Abs(Diff)
      142. Diff = Sqr((s - a) * (s - b) * (s - c) / s) - rho
      143. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbCrLf & "rho=Sqr((s-a)*(s-b)*(s-c)/s) mit s=(a+b+c)/2"
      144. If Abs(Diff) > 10 ^ -12 Then Plausi = Plausi & vbTab & " Diff.: " & Diff
      145. gesDiff = gesDiff + Abs(Diff)
      146. If Right(Plausi, 2) = vbCrLf Then Plausi = Plausi & vbCrLf & "keine nennenswerten Differenzen"
      147. If gesDiff < 10 ^ -6 Then
      148. Meldung = vbInformation
      149. ElseIf gesDiff < 1 Then
      150. Meldung = vbExclamation
      151. Else
      152. Meldung = vbCritical
      153. End If
      154. MsgBox Plausi, Meldung, "Dreieck"
      155. End If
      157. End Sub

    Facebook
    Telefonspende