Trójmian kwadratowy
Program rysujący zarówno funkcje liniowe jak i kwadratowe.
Dim a, b, c, d, p, q, x1, x2 As Single
Dim m As Byte
Const znaki = "0123456789-,"
Private Sub btnsiatka_Click()
Call rysuj_osie
wykres.Scale (0, 0)-(2000, 2000)
'siatka
For i = 0 To 800 Step 100
wykres.Line (1027, 100 + i)-(2000, 100 + i), RGB(124, 175, 185)
wykres.Line (0, 100 + i)-(980, 100 + i), RGB(124, 175, 185)
wykres.Line (100 + i, 0)-(100 + i, 980), RGB(124, 175, 185)
wykres.Line (100 + i, 1018)-(100 + i, 2000), RGB(124, 175, 185)
Next
For i = 1000 To 1900 Step 100
wykres.Line (100 + i, 0)-(100 + i, 980), RGB(124, 175, 185)
wykres.Line (0, 100 + i)-(975, 100 + i), RGB(124, 175, 185)
wykres.Line (1027, 100 + i)-(2000, 100 + i), RGB(124, 175, 185)
wykres.Line (100 + i, 1018)-(100 + i, 2000), RGB(124, 175, 185)
Next
End Sub
Private Sub btnWykres_Click()
Call wprowadz
Call rysuj_osie
Call rysuj_wykres
End Sub
Private Sub Form_Load()
Call czysc_Click
End Sub
Private Sub hA_Change()
txtA.Text = hA.Value
End Sub
Private Sub hB_Change()
txtB.Text = hB.Value
End Sub
Private Sub hC_Change()
txtC.Text = hC.Value
End Sub
Private Sub txtA_Change()
If txtA.Text = 0 Then
Beep
MsgBox "Podaj a różne od zera, w przeciwnym wypadku otrzymasz funkcje liniową."
End If
'jeżeli podana liczba jest większa niż trzycyfrowa nie pozwala na jej wpisanie
If Len(txtA.Text) > 4 Then
'wydaje odgłos gdy chcemy wpisać więcej niż trzycyfrową liczbę
Beep
txtA.Text = Left(txtA.Text, 4)
End If
End Sub
Private Sub txtA_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then txtB.SetFocus ' jeżeli enter to przejdź do b
If InStr(znaki, Chr(KeyAscii)) = 0 Then ' jezeli znaki wpisywane z klawiatury sa inne od tych ze stalej
KeyAscii = 0 'pusty znak
End If
End Sub
Private Sub txtB_Change()
If Len(txtB.Text) > 4 Then
Beep
txtB.Text = Left(txtB.Text, 4)
End If
End Sub
Private Sub txtB_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then txtC.SetFocus
If InStr(znaki, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub
Private Sub txtC_Change()
If Len(txtC.Text) > 4 Then
Beep
txtC.Text = Left(txtC.Text, 4)
End If
End Sub
Private Sub txtC_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then txtA.SetFocus
If InStr(znaki, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub
Private Sub rysuj_osie()
Dim x, y, xk, yk As Double
wykres.Scale (0, 0)-(2000, 2000)
'osie współrzędnych
wykres.Line (0, 1000)-(2000, 1000)
wykres.Line (1000, 0)-(1000, 2000)
'współrzędne
For i = 0 To 2000 Step 100
wykres.Line (100 + i, 985)-(100 + i, 1020)
wykres.Line (980, 100 + i)-(1025, 100 + i)
Next i
'strzałki
wykres.Line (965, 60)-(1000, 0)
wykres.Line -(1045, 60)
wykres.Line (1965, 965)-(2000, 1000)
wykres.Line (1965, 1045)-(2000, 1000)
End Sub
Private Sub rysuj_wykres()
'rysowanie wykresu
For i = -10 To 9 Step 0.005
x = i
y = x * x * a + x * b + c
xk = i + 1
yk = xk * xk * a + xk * b + c
wykres.Line (1000 + x * 100, 1000 - y * 100)-(1000 + xk * 100, 1000 - yk * 100), RGB(255, 0, 0)
Next
End Sub
Private Sub czysc_Click()
wykres.Cls
Call rysuj_osie
lblp.Caption = ""
lblq.Caption = ""
lblx1.Caption = ""
lblx2.Caption = ""
txtA.Text = 1
txtB.Text = 0
txtC.Text = 0
End Sub
Private Sub koniec_Click()
m = MsgBox("Czy na pewno chcesz opuścić program?", vbQuestion + vbOKCancel, "Pytanie")
If m = 1 Then
Unload Me
End
End If
End Sub
Private Sub wprowadz()
a = txtA.Text
b = txtB.Text
c = txtC.Text
If a = 0 Then ' kiedy pierwsza współrzędna jest równa zero cofa sie do okna txtA
Call txtA_Change
Else
'dodatkowe obliczenia
'delta
d = b * b - 4 * a * c
'miejsca zerowe
If d < 0 Then
lblx1.Caption = "Brak"
lblx2.Caption = "Brak"
ElseIf d = 0 Then
x1 = (-b / (2 * a))
zaokragleniex1 = Round(CDbl(x1), CLng(2)) 'zaokrąglenie pierwsza wartość do double, druga long, dwa miejsce po przecinku
lblx1.Caption = zaokragleniex1
lblx2.Caption = zaokragleniex1
Else
x1 = (-b - Sqr(d)) / (2 * a)
x2 = (-b + Sqr(d)) / (2 * a)
zaokragleniex1 = Round(CDbl(x1), CLng(2))
zaokragleniex2 = Round(CDbl(x2), CLng(2))
lblx1.Caption = zaokragleniex1
lblx2.Caption = zaokragleniex2
End If
'wierzchołek
p = -b / (2 * a)
q = -d / (4 * a)
zaokragleniep = Round(CDbl(p), CLng(2))
zaokraglenieq = Round(CDbl(q), CLng(2))
lblp.Caption = zaokragleniep
lblq.Caption = zaokraglenieq
End If
End Sub
