Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
48
Добавлен:
02.05.2014
Размер:
271.36 Кб
Скачать

Код программы

Запуск программы сопровождается появлением окошка frmSplash.

Вот его код.

frmSplash

Private Sub Form_Click()

Unload Me

frmMainMDI.Show

End Sub

Модуль родительского окна.

frmMainMDI

Private Sub mnuAbout_Click()

frmSplash.Show

End Sub

Private Sub mnuBlockSh_Click()

frmBlockSh.Show

End Sub

Private Sub mnuDecision_Click()

frmDecision.Show

End Sub

Private Sub mnuExit_Click()

End

End Sub

Private Sub mnuVis_Click()

frmVis.Show

End Sub

Здесь выполняется демонстрация блок-схемы. Так как вся схема в окно не влезет, используем VScrollBar.

frmBlockSh

Private Sub VScroll1_Change()

Image1.Top = -VScroll1.Value * 12

End Sub

Private Sub VScroll1_Scroll()

Image1.Top = -VScroll1.Value * 12

End Sub

Далее происходит ввод данных из текстового файла, и последующее их использование, для решения системы с помощью метода Гаусса

frmDecision

Dim A()

Dim B()

Dim x()

Dim N As Integer

Private Sub Command1_Click()

Picture1.Cls

Open Text2 For Input As #1

Line Input #1, dS

N = CInt(dS)

If N > 10 Then

MsgBox "Порядок системы должен быть меньше или равен 10"

Exit Sub

End If

ReDim A(1 To N, 1 To N + 1)

ReDim B(1 To N)

ReDim x(1 To N)

For i = 1 To N

Line Input #1, s

s0 = Split(s, " ")

For j = 1 To N + 1

A(i, j) = s0(j - 1)

Picture1.Print A(i, j) & " ";

Next

Picture1.Print

Next

Close #1

Eq_Sol A(), x(), N, 0.01

FG.Cols = N + 1

For i = 1 To N

FG.Col = i

FG.Text = Format(x(i), "0.000")

Next

End Sub

Код программы выполняющая визуализацию решения при порядке системы равном 2

frmVis

Dim A(1, 2)

Dim C(1)

Sub Draw()

Pic.Cls

X0 = 400

y0 = Pic.Height - 400

Pic.Line (x0, y0)-(Pic.Width - x0, y0)

Pic.Line (x0, y0)-(x0, Pic.Height - y0)

Pic.Line (Pic.Width - x0, y0)-(Pic.Width - x0 - 100, 3250)

Pic.Line (Pic.Width - x0, y0)-(Pic.Width - x0 - 100, 3400)

Pic.Line (x0, Pic.Height - y0)-(x0 - 100, y0 - 2800)

Pic.Line (x0, Pic.Height - y0)-(x0 + 100, y0 - 2800)

Pic.PSet (Pic.Width - x0, y0)

Pic.Print "X"

Pic.PSet (x0, Pic.Height - y0 + 150)

Pic.Print "Y"

m = 200

h = 0.01

C(0) = RGB(255, 0, 0)

C(1) = RGB(0, 0, 255)

Found = False

For i = 0 To 1

For X = 0 To 100 Step h

Fx = F(X, i)

X1 = X0 + X * m

Y1 = y0 - Fx * m

Fx = F(X + h, i)

X2 = X0 + (X + h) * m

Y2 = y0 - Fx * m

Pic.DrawWidth = 1

Pic.Line (X1, Y1)-(X2, Y2), C(i)

Pic.DrawWidth = 1

If Round(F(X, 0), 1) = Round(F(X, 1), 1) And Not Found Then

Found = True

Pic.Circle (X1, Y1), 50

Pic.DrawStyle = 2

Pic.Line (X1, Y1)-(X1, y0), RGB(100, 100, 100)

Pic.Print "x=" & Format(X, "0.00")

Pic.Line (X1, Y1)-(X0, Y1), RGB(100, 100, 100)

Pic.Print " y=" & Format(Fx, "0.00")

Pic.DrawStyle = 0

End If

Next

Next

End Sub

Sub MakeMatrix()

s0 = Split(Text1, vbCrLf)

For i = 0 To 1

s1 = Split(s0(i), " ")

For j = 0 To 2

A(i, j) = s1(j)

Next

Next

End Sub

Private Sub Command1_Click()

MakeMatrix

Draw

End Sub

Function F(X, i)

F = (A(i, 2) - A(i, 0) * X) / A(i, 1)

End Function

Это сам метод Гаусса.

mdlGauss

Public Sub Eq_Sol(A_(), x(), N As Integer, Epsilon)

Dim Result As Boolean

Dim R(10, 10) As Double

Dim k As Long

Dim u As Long

Dim m As Long

Dim j As Long

Dim i As Long

Dim t As Double

For i = 1 To N

For j = 1 To N + 1

R(i, j) = A_(i, j)

Next

Next

'ReDim X(1 To N)

u = 0

Result = True

Do

u = u + 1

k = u

Do While Abs(R(k, u)) <= Epsilon And k < N

k = k + 1

Loop

If k <> N Or Abs(R(N, u)) > Epsilon Then

If k <> u Then

m = u

Do

t = R(u, m)

R(u, m) = R(k, m)

R(k, m) = t

m = m + 1

Loop Until Not m <= N + 1

End If

j = N + 1

Do

R(u, j) = R(u, j) / R(u, u)

j = j - 1

Loop Until Not j >= u

m = N + 1

If k + 1 <= N Then

i = k + 1

Do

j = u + 1

Do

R(i, j) = R(i, j) - R(i, u) * R(u, j)

j = j + 1

Loop Until Not j <= m

i = i + 1

Loop Until Not i <= N

End If

Else

Result = False

End If

Loop Until Not (u <> N And Result)

If Result Then

i = N

Do

x(i) = R(i, m)

If i <> 1 Then

k = i - 1

Do

R(k, m) = R(k, m) - R(k, i) * x(i)

k = k - 1

Loop Until Not k >= 1

End If

i = i - 1

Loop Until Not i >= 1

End If

End Sub

Заключение

В ходе этой курсовой работы мной был рассмотрен метод решения систем линейных уравнений. Система размерностью N≤10 была решена методом Гаусса, результаты были выведены на FlexGrid. Так же присутствует визуализация решения при N=2.

Были рассмотрены и опробованы: родительское окно MDI-интерфейса, обычные формы и просто компоненты Visual Basica.

Список использованной литературы:

1.Ананьев А. , Федоров А. «Самоучитель Visual Basic 6.0» ,

БХВ - Петербург, 2005 г..

2.Письменный Д. «Конспект лекций по высшей математике», 1часть., Москва, 2003 г..

Соседние файлы в папке Курсовая по Visual Basic