Dim m(12) As String
Dim pi As String
 
 
Function kd3p()
On Error Resume Next
pi = 3.14159265358979
 
Dim x(3) As String
Dim y(3) As String
t = ""
Dim d, a, b, c, r, u, f, aa, bb, rr, uu, ff
 
 
x(0) = CDbl(tx1.Text)
x(1) = CDbl(tx2.Text)
x(2) = CDbl(tx3.Text)
 
y(0) = CDbl(ty1.Text)
y(1) = CDbl(ty2.Text)
y(2) = CDbl(ty3.Text)
 
For i = 0 To 3
If Not IsNumeric(x(i)) Then
MsgBox "keine nummer"
End If
If Not IsNumeric(y(i)) Then
MsgBox "keine nummer"
End If
Next
 
 
For i = 0 To 3
j = i * 4
m(j) = 1
m(j + 1) = -2 * x(i)
m(j + 2) = -2 * y(i)
m(j + 3) = -x(i) * x(i) - y(i) * y(i)
Next
MsgBox GLSL(3, 4)
 
 
 
For i = 0 To 12 Step 5
If Not m(i) = 1 Then
MsgBox ("Es gibt keinen solchen Kreis!")
End If
Next
 
 
 
a = Round(m(7), 15)
b = Round(m(11), 15)
r = Round(Sqr(a * a + b * b - m(3)), 15)
u = Round(2 * pi * r, 15)
f = Round(pi * r * r, 15)
aa = ZahlStr(a)
bb = ZahlStr(b)
rr = ZahlStr(r)
uu = ZahlStr(u)
ff = ZahlStr(f)
 
 
'asx = ""
'For i = 0 To 12
'asx = asx & m(i) & vbNewLine
'Next
'MsgBox asx
 
If (Abs(b) > r) Then
t1 = "   keine"
ElseIf (Abs(b) = r) Then
t1 = "   x0 = " + ZahlStr(a)
ElseIf d = Sqr(r * r - b * b) Then
t1 = "   x01 = " & ZahlStr(a - d) & vbNewLine & "   x02 = " & ZahlStr(a + d)
End If
 
 
 
 
 
If (Abs(a) > r) Then
t3 = "   keine"
ElseIf (Abs(a) = r) Then
t3 = "   y0 = " + ZahlStr(b)
ElseIf d = Sqr(r * r - a * a) Then
t3 = "   y01 = " & ZahlStr(b - d) & vbNewLine & "   y02 = " & ZahlStr(b + d)
End If
 
 
t = "xm = " & aa & vbNewLine & "ym = " & bb & vbNewLine & "r  = " & rr & _
  vbNewLine & "u  = " & uu & vbNewLine & "A  = " & ff & vbNewLine & vbNewLine & _
  "Schnittpunkte" & vbNewLine & "• mit x-Achse:" & vbNewLine & t1 & vbNewLine & _
  "• mit y-Achse:" & vbNewLine & t3
 
 
Label1.Caption = t
 
End Function
 
 
 
 
 
 
Function ZahlStr(x)
 
t = Round(x, 12)
t = Replace(t, ".", ",")
t = Replace(t, "-,", "-0,")
 
If InStr(1, t, ",") = 0 Then
t = 0 + t
End If
ZahlStr = t
End Function
 
Function GLSL(nz, ns)
 
    Dim i, j, k
    Dim q
    For j = 0 To ns - 1
 
        '// Diagonalenfeld normalisieren
        q = m(j * ns + j)
        If q = 0 Then
            '//Gewährleisten, daß keine 0 in der Diagonale steht
            For i = j + 1 To nz
 
                '// Suche Reihe mit Feld <> 0 und addiere dazu
                If Not m(i * ns + j) = 0 Then
                    For k = 0 To ns
 
                        m(j * ns + k) = m(j * ns + k) + m(i * ns + k)
                       'm(j * ns + k) += m(i * ns + k)   <<--- original, ich 
                       ' hoffe richtig umgeformt
                    Next
                    q = m(j * ns + j)
                    'break <--- sollte die schleife hier abbrechen, hab exit 
                    ' for anstelle
                    Exit For
                End If
            Next
        End If
        If Not q = 0 Then
            '// Diagonalen auf 1 bringen
            For k = 0 To ns
                m(j * ns + k) = m(j * ns + k) / q
            Next
        End If
        '// Spalten außerhalb der Diagonalen auf 0 bringen
        For i = 0 To nz
 
            If Not i = j Then
                q = m(i * ns + j)
                For k = 0 To ns
                    m(i * ns + k) = m(i * ns + k) - (q * m(j * ns + k))
                   'm(i * ns + k) -= q * m(j * ns + k)   <<--- original, ich 
                   ' hoffe richtig umgeformt
                Next
            End If
        Next
    Next
End Function
 
 
 
Private Sub Command1_Click()
kd3p
End Sub
 
Private Sub Form_Load()
tx1.Text = 5
tx2.Text = 0
tx3.Text = 15
ty1.Text = 0
ty2.Text = 15
ty3.Text = 0
End Sub

________________________
www.cyberspeed.eu.tt

Beitrag wurde zuletzt am 14.03.10 um 03:48:47 editiert.