'Form zur Lösung einer quadratischen Gleichung
Option Explicit
 
Dim a As Double, b As Double, c As Double 'a * x^2 + b * x + c = 0
Dim p As Double, q As Double
 
Dim diskr As Double                       'Diskriminante
Dim x1 As Double, x2 As Double            'Lösungen für x
Dim N As Integer                          'Nachkommastellen ( 
' Rundungsgenauigkeit)
 
'Erforderliche Controls:
'TB_A, TB_B, TB_C      Textboxen für die Parameter der Gleichung
'TB_N                  Textbox für die Rundungsgenauigkeit (alle Werte)
'LB_Result             Label für das Ergebnis
'CB_Rechnen            CommandButton für die Berechnung
 
Private Sub CB_Rechnen_Click()
 
If Not IsNumeric(tb_a.Text) Then
   MsgBox "Geben sie einen numerischen Wert für a ein": Exit Sub
End If
If Not IsNumeric(tb_b.Text) Then
   MsgBox "Geben sie einen numerischen Wert für b ein": Exit Sub
End If
If Not IsNumeric(tb_c.Text) Then
   MsgBox "Geben sie einen numerischen Wert für c ein": Exit Sub
End If
If Not IsNumeric(tb_n.Text) Then
   MsgBox "Geben sie die Nachkommastellen im Bereich 1-4 ein": Exit Sub
End If
If CDbl(tb_n.Text) < 1 Or CDbl(tb_n.Text) > 4 Then
   MsgBox "Geben sie die Nachkommastellen im Bereich 1-4 ein": Exit Sub
End If
 
N = CInt(tb_n.Text)
a = Round(CDbl(tb_a.Text), N)
b = Round(CDbl(tb_b.Text), N)
c = Round(CDbl(tb_c.Text), N)
 
If a = 0 Then
   MsgBox "Es liegt keine quadratische Gleichung vor": Exit Sub
End If
 
p = b / a: q = c / a
diskr = (p / 2#) * (p / 2#) - q
diskr = Round(diskr, N)
 
If diskr < 0 Then
   lb_Result.Caption = "Keine reelle Lösung (neg. Diskriminante)"
ElseIf diskr = 0 Then
   lb_Result.Caption = CStr(Round(-p / 2#, N))
Else
   x1 = -p / 2# + Sqr(diskr)
   x2 = -p / 2# - Sqr(diskr)
   lb_Result.Caption = CStr(Round(x1, N)) & "      " & CStr(Round(x2, N))
End If
 
End Sub