|
Option Explicit
Private Type UDT_WERTEPAAR
X As Double
Y As Double
Err As Boolean
End Type
Private Const X1 As Double = (-5)
Private Const X2 As Double = 5
Private Const Y1 As Double = 5
Private Const Y2 As Double = (-5)
Private aWerte() As UDT_WERTEPAAR
Private lBerechnungsschritte As Long
Private Sub Form_Load()
ZeichenflächeInitialisieren
cboFunktionsterm.AddItem "x+3-2"
cboFunktionsterm.AddItem "x^2+y^2"
cboFunktionsterm.AddItem "x^3+y^3"
cboFunktionsterm.AddItem "y^2-x^2"
cboFunktionsterm.AddItem "3*x^3+7*x^2+6*x"
cboFunktionsterm.ListIndex = 0
End Sub
Private Sub cmdFunktionZeichnen_Click()
lBerechnungsschritte = CLng(txtBerechnungsschritte.Text)
If (chkBildflächeLöschen.Value = 1) Then
picFunktion.Cls
ZeichenflächeInitialisieren
End If
FunktionswerteErmitteln
FunktionZeichnen
End Sub
Private Sub FunktionswerteErmitteln()
Dim bFehler As Boolean
Dim X As Double
Dim Y As Double
Dim l As Long
Dim sTemp As String
ReDim aWerte(0 To (lBerechnungsschritte))
X = X1
For l = 0 To (lBerechnungsschritte)
bFehler = False
sTemp = cboFunktionsterm.Text
sTemp = Replace(sTemp, "x", X)
sTemp = Replace(sTemp, ",", ".")
On Error GoTo errHandler
Y = sclFunktion.Eval(sTemp)
If (bFehler = False) Then
With aWerte(l)
.X = X
.Y = Y
.Err = False
End With
Else
With aWerte(l)
.X = X
.Y = 0
.Err = True
End With
End If
X = X + (X2 - X1) / lBerechnungsschritte
Next l
Exit Sub
errHandler:
bFehler = True
Resume Next
End Sub
Private Sub FunktionZeichnen()
Dim l As Long
picFunktion.DrawStyle = 0
picFunktion.ForeColor = vbBlue
picFunktion.DrawWidth = 1
For l = 0 To lBerechnungsschritte
If (aWerte(l).Err = False) Then
If (aWerte(l).Y < Y1) And (aWerte(l).Y > Y2) Then
picFunktion.PSet (aWerte(l).X, aWerte(l).Y)
DoEvents
End If
End If
Next l
End Sub
Private Sub ZeichenflächeInitialisieren()
Dim a As Double
Dim b As Double
Dim i As Integer
picFunktion.AutoRedraw = True
picFunktion.Scale (X1, Y1)-(X2, Y2)
picFunktion.DrawStyle = 2
picFunktion.ForeColor = &HE0E0E0
a = Y2
For i = 1 To 10
picFunktion.Line (X1, a)-(X2, a)
a = a + (Y1 - Y2) / 10
Next i
a = X1
For i = 1 To 10
picFunktion.Line (a, Y1)-(a, Y2)
a = a + (X2 - X1) / 10
Next i
picFunktion.DrawStyle = 0
picFunktion.ForeColor = &H0
picFunktion.Line (X1, 0)-(X2, 0)
picFunktion.Line (0, Y1)-(0, Y2)
picFunktion.ForeColor = &H0
a = X1
b = 0
For i = 1 To 10
picFunktion.CurrentX = a
picFunktion.CurrentY = b
picFunktion.Print Format(a, "#0.00")
a = a + (X2 - X1) / 10
Next i
a = 0
b = Y2
For i = 1 To 10
picFunktion.CurrentX = a
picFunktion.CurrentY = b
picFunktion.Print Format(b, "#0.00")
b = b + (Y1 - Y2) / 10
Next i
End Sub
Private Sub picFunktion_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Dim sPosition As String
sPosition = "(" & Format(X, "0.00") & " | " & _
Format(Y, "0.00") & ")"
If (lblMausposition.Caption <> sPosition) Then
lblMausposition.Caption = sPosition
End If
End Sub
|
|