Rozdz7


'LISTING 7.1

Option Explicit
Dim a, b, c, delta, x, x1, x2, y1, y2, nr As Single
Dim i As Byte
Dim y(32) As Single

'Obok osi będą pola tekstowe opisujące ich wartości. Te wartości zostaną
'sformatowane w sposób przedstawiony w procedurze Czcionka

Sub Czcionka()
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Normalny"
.Size = 8
End With

'Ukrywamy krawędzie pól tekstowych
Selection.ShapeRange.Line.Visible = msoFalse
End Sub

'Najpierw narysujemy układ współrzędnych (to będą statyczne obiekty
'graficzne).

Sub Układ()

'Przyjmujemy współrzędne środka układu (280,160) i rysujemy
'osie X i Y podając 'współrzędne ich pierwszego i ostatniego punktu

ActiveSheet.Lines.Add 120, 160, 460, 160
ActiveSheet.Lines.Add 280, 8, 280, 320

'Na osiach umieścimy podziałkę (krótkie odcinki) o długości 4 punktów
'i umieszczone co 10 punktów. Narysowanie podziałki osi X.
'Współrzędne y1 i y2 będą miały stałą wartość, bo są to odcinki
'umieszczone na jednym poziomie. Pierwszy odcinek będzie narysowany
'w punkcie 140 (dla i = 1) licząc od lewej krawędzi ekranu, następne
'w punktach, kórych ta 'odległość będzie zwiększała się o 10

For i = 1 To 29
x1 = 130 + i * 10
y1 = 158
x2 = 130 + i * 10
y2 = 162

'Po obliczeniu współrzędnych początku i końca linii zostaje ona
'narysowana

ActiveSheet.Lines.Add x1, y1, x2, y2
Next

'Narysowanie podziałki osi Y. Współrzędne x1 i x2 będą miały stałą
'wartość, bo są to odcinki umieszczone w tym samym pionie.
'Pierwszy odcinek będzie narysowany w punkcie 20 (dla i = 1) licząc od
'górnej krawędzi ekranu, następne w punktach, kórych ta odległość
'będzie zwiększała się o 10

For i = 1 To 30
x1 = 278
y1 = 10 + i * 10
x2 = 282
y2 = 10 + i * 10
ActiveSheet.Lines.Add x1, y1, x2, y2
Next

'Narysowanie zakończeń osi w formie strzałek, osi X z prawej strony,
'Y z lewej

ActiveSheet.Lines.Add 276, 15, 280, 8
ActiveSheet.Lines.Add 284, 15, 280, 8
ActiveSheet.Lines.Add 453, 157, 460, 160
ActiveSheet.Lines.Add 453, 163, 460, 160

'Narysowanie pól tekstowych z wartościami na osiach X i Y. Ustalamy
'poziomą orientację tekstu, podajemy współrzędne górnego, lewego
'narożnika pola tekstowego, jego szerokość i wysokość oraz znajdujący
'się w nim tekst

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 326.25, _
163.5, 14#, 14#).Select
Selection.Characters.Text = "5"
Call Czcionka

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 223, _
163.5, 14#, 14#).Select
Selection.Characters.Text = "-5"
Call Czcionka

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 172, _
163.5, 19#, 19#).Select
Selection.Characters.Text = "-10"
Call Czcionka

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 373, _
163.5, 18#, 16#).Select
Selection.Characters.Text = "10"
Call Czcionka

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 260, _
105, 14#, 14#).Select
Selection.Characters.Text = "50"
Call Czcionka

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 260, _
205, 18#, 18#).Select
Selection.Characters.Text = "-50"
Call Czcionka

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 258, 55, _
21#, 18#).Select
Selection.Characters.Text = "100"
Call Czcionka

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 255, 255, _
23#, 23#).Select
Selection.Characters.Text = "-100"
Call Czcionka

'Narysowaliśmy 73 obiekty graficzne. Jest to początkowa ich numeracja.
'Wartość tą umieścimy w komórce M2 (poza ekranem). Dotychczas
'przekonaliśmy się, że dane można przechowywać w komórkach arkusza lub
'przypisać je zmiennym w module. W tym przypadku konieczne jest
'przechowanie informacji o ilości dotychczas utworzonych obiektów
'graficznych w komórce, bo tylko wtedy możemy ją odczytać po ponownym
'otwarciu skoroszytu. Tą procedurę uruchamiamy tylko jeden raz.
'W przypadku wystąpienia w przyszłości błędów (a może przekroczymy
'zakres zmiennej?) należy zaznaczyć linie ostatniego wykresu i skasować
'je, do komórki M2 wpisać 73, albo zmienić arkusz lub skopiować
'procedury, wkleić je do nowego skoroszytu i na początku uruchomić
'procedurę Układ.

Range("m2").Value = 73
Range("a1").Select

'W celu lepszej widoczności wykresu ukrywamy linie siatki arkusza.

ActiveWindow.DisplayGridlines = False
End Sub


'LISTING 7.2

Sub Wykres()

'Przechwytujemy zdarzenie kliknięcia przycisku Anuluj, w trzech oknach
'służących do wprowadzania współczynników funkcji. Po kliknięciu tego
'przycisku nastąpi zakończenie działania procedury

On Error GoTo Błąd

'Usunięcie poprzedniego wykresu. Przy pierwszym wykresie komórka M1
'jest pusta, stąd początkowe sprawdzenie jej wartości.

If Range("m1").Value > 0 Then
For nr = Range("m1").Value To Range("m2").Value
ActiveSheet.Shapes("Line" & nr).Select
Selection.Delete
Next

'W komórkach A6:B24 umieścimy dane o funkcji, m.in. jej wzór,
'pierwiastki. Dane dotyczące poprzedniego wykresu są usuwane.

Range("a6", "b24").Select
Selection.Clear
Range("a1").Select
End If

'Wprowadzenie wartości współczynników a, b, c. Zwróćmy uwagę,
'że np. podając a = 0 otrzymamy równanie prostej. W przypadku braku
'w polu wartości liczbowej z przyjętego zakresu liczb od -100 do 100
'nastąpi zakończenie działania procedury

a = InputBox( _
prompt:="Podaj wartość współczynnika a:", _
Title:="Równanie kwadratowe!", _
Default:="")

If a < -100 Or a > 100 Then Exit Sub
b = InputBox( _
prompt:="Podaj wartość współczynnika b:", _
Title:="Równanie kwadratowe!", _
Default:="")
If a < -100 Or a > 100 Then Exit Sub
c = InputBox( _
prompt:="Podaj wartość współczynnika c:", _
Title:="Równanie kwadratowe!", _
Default:="")

If a < -100 Or a > 100 Then Exit Sub

'Obliczamy deltę
delta = b * b - (4 * a * c)

'W zależności od wartości współczynników otrzymamy różnie położony
'wykres. Ramiona paraboli mogą być skierowane do góry ekranu, wówczas
'dane dotyczące wykresu umieścimy na dole ekranu (i odwrotnie).

If delta > 0 And a > 0 Then
x1 = (-b - Sqr(delta)) / (2 * a)
x2 = (-b + Sqr(delta)) / (2 * a)
Range("a20").Value = "Równanie kwadratowe: y =" & a & "x2 +" & b & _
"x +" & c
Range("a22").Value = "Delta ="
Range("b22").Value = delta
Range("a23").Value = "x1 ="
Range("b23").Value = x1
Range("a24").Value = "x2 ="
Range("b24").Value = x2
Range("b22", "b24").NumberFormat = "0.00"
Range("a22", "a24").HorizontalAlignment = xlRight
ElseIf delta > 0 And a < 0 Then
ElseIf delta > 0 And a < 0 Then
x1 = (-b - Sqr(delta)) / (2 * a)
x2 = (-b + Sqr(delta)) / (2 * a)
Range("a6").Value = "Równanie kwadratowe: y =" & a & "x2 +" & b & _
"x +" & c
Range("a8").Value = "Delta ="
Range("b8").Value = delta
Range("a9").Value = "x1 ="
Range("b9").Value = x1
Range("a10").Value = "x2 ="
Range("b10").Value = x2
Range("b8", "b10").NumberFormat = "0.00"
Range("a8", "a10").HorizontalAlignment = xlRight
ElseIf delta < 0 And a > 0 Then
Range("a20").Value = "Równanie kwadratowe: y =" & a & "x2 +" & b & _
"x +" & c
Range("a22").Value = "Delta ="
Range("b22").Value = "< 0"
Range("b22").NumberFormat = "0.00"
Range("a22").HorizontalAlignment = xlRight
ElseIf delta < 0 And a < 0 Then
Range("a6").Value = "Równanie kwadratowe: y =" & a & "x2 +" & b & _
"x +" & c
Range("a8").Value = "Delta ="
Range("b8").Value = "< 0"
Range("b8").NumberFormat = "0.00"
Range("a8").HorizontalAlignment = xlRight
ElseIf delta = 0 And a > 0 Then
x = -b / 2 * a
Range("a20").Value = "Równanie kwadratowe: y =" & a & "x2 +" & b & _
"x +" & c
Range("a22").Value = "Delta ="
Range("b22").Value = delta
Range("a23").Value = "x ="
Range("b23").Value = x
Range("b22").NumberFormat = "0.00"
Range("a22").HorizontalAlignment = xlRight
ElseIf delta = 0 And a < 0 Then
x = -b / 2 * a
Range("a6").Value = "Równanie kwadratowe: y =" & a & "x2 +" & b & _
"x +" & c
Range("a8").Value = "Delta ="
Range("b8").Value = delta
Range("a9").Value = "x ="
Range("b9").Value = x
Range("b8").NumberFormat = "0.00"
Range("a8, a9").HorizontalAlignment = xlRight
ElseIf a = 0 And b <> 0 Then
x = -c / b
Range("a20").Value = "Równanie liniowe: y =" & b & "x +" & c
Range("a22").Value = "x ="
Range("b22").Value = x
Range("b22").NumberFormat = "0.00"
Range("a22").HorizontalAlignment = xlRight
ElseIf a = 0 And b = 0 Then
Range("a20").Value = "Prosta: y =" & c
End If

'Narysowanie wykresu. Zerujemy zmienną numer, wykres rozpoczynamy
'od x = -15

nr = 0
x = -15

'i kończymy dla x = 15, stąd 31 obiegów pętli

For i = 1 To 31

'Obliczamy wartość funkcji dla danej wartości x
y(i) = a * x * x + b * x + c

'Obliczamy współrzędne początku linii uwzględniając środek układu
'współrzędnych

x1 = 280 + x * 10
y1 = 160 - y(i)

'Obliczamy współrzędne końca linii również uwzględniając środek
'układu współrzędnych

y(i + 1) = a * (x + 1) * (x + 1) + b * (x + 1) + c
x2 = 280 + (x + 1) * 10
y2 = 160 - y(i + 1)

'Wykres będzie widoczny dla wartości y1 (y2) >= 10 lub
'y1 (y2) <= 320, wówczas wartość zmiennej i będzie zwięszała się
'o 1. Dla innych wartości y wykres nie będzie rysowany, ale skacząc
'do etykiety Dalej wymusimy zwiększenie zmiennej i dodatkowo o 1

If y1 > 320 Or y2 > 320 Or y1 < 10 Or y1 < 10 Then GoTo Dalej

'W przypadku, kiedy y2 > 0 (jest to wartość po uwzględnieniu
'przeskalowania osi) rysowany jest wykres

If y2 >= 10 Then
ActiveSheet.Lines.Add(x1, y1, x2, y2).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
'Po każdym narysowaniu linii obliczamy ich ilość
nr = nr + 1
End If
Dalej:
x = x + 1
Next

'Przekazanie danych o ilości obiektów graficznych do komórek arkusza
'niezbędnych do usunięcia wykresu po ponownym uruchomieniu procedury

Range("m1").Value = Range("m2").Value + 1
Range("m2").Value = Range("m1").Value + nr - 1
Range("a1").Select
Błąd:
End Sub










Wyszukiwarka

Podobne podstrony:
rozdz7
ROZDZ7E (2)
fotogrametria rozdz7
ROZDZ7C (2)
ROZDZ7A
ROZDZ7D (2)
ROZDZ7
ROZDZ7
ROZDZ7B

więcej podobnych podstron