«Решение слау методом Халецкого VBasic»

Блок-схема метода Халецкого

ret = MsgBox("Обнаружена ошибка во входных данных.", vbCritical, "Ошибка")

Exit For

Exit For

End If

A(I, j) =dDemo.TextMatrix(I, j)

Next

Next

For I = 1 To N

For j = 1 To N

If A(I, j) < 0 Then

Picture1.Print Format(A(I, j), " 0.00"); "*x"; "("; I; j; ")"; " ";

Else

Picture1.Print "+"; Format(A(I, j), " 0.00"); "*x"; "("; I; j; ")"; " ";

End If

Next j

B(I) = A(I, N + 1)

Picture1.Print "="; Format(B(I), " 0.00")

Picture1.Print

Next I

'///

On Error GoTo Handler

Call Eq_Sol(A, B, X, N)

Open App.Path & "\otvet.txt" For Output As #2

Print #2, "Результаты решения СЛАУ методом Халецкого:"

For I = 1 To N

Print #2, "X=" & X(I)

Picture2.Print "X"; I; " = "; Format(X(I), " 0.00")

Picture2.Print 'Пустая строка

Next

Close #2

Handler:

If Err.Number <> 0 Then

ret = Msgox("Обнаружена ошибка во входных данных.", vbCritical, "Ошибка")

End If

End Sub

Private Sub open_Click()

Form4.Show

End Sub

Private Sub quit_Click()

End

End Sub

Private Sub resh_Click()

Command1 = True

End Sub

Private Sub FlxGrdDemo_KeyPress(KeyAscii As Integer)

Select Case KeyAscii

Case vbKeyReturn

' Когда пользователь нажимает

' клавишу Enter, этот код

' осуществляет переход к

' следующей ячейке или ряду

With FlxGrdDemo

If .Col + 1 <= .Cols - 1 Then

.Col = .Col + 1

ElseIf .Row + 1 <= .Rows - 1 Then

.Row = .Row + 1: .Col = 0

Else

.Row = 1: .Col = 0

End If

End With

Case vbKeyBack

' Удаляет предыдущий символ при

' нажатии клавиши Backspace

With FlxGrdDemo

If Trim(.Text) <> " " Then _

.Text = Mid(.Text, 1, Len(.Text) - 1)

End With

Case Is < 32

' Не разрешает вводить непечатные символы

Case Else ' Разрешает печатать все

With FlxGrdDemo

.Text = .Texthr(KeyAscii)

End With

End Select

End Sub

Private Sub FlxGrdDemo_KeyUp(KeyCode As Integer, _

Shift As Integer)

Select Case KeyCode

Case vbKeyC And Shift = 2 ' Ctrl + C

' Копирует символы

Clipboard.Clear

Clipboard.SetText FlxGrdDemo.Text

KeyCode = 0

Case vbKeyV And Shift = 2 ' Ctrl + V

' Вставляет символы

FlxGrdDemo.Text = Clipboard.GetText

KeyCode = 0

Case vbKeyX And Shift = 2 ' Ctrl + X

' Вырезает символы

Clipboard.Clear

Clipboard.SetText FlxGrdDemo.Text

FlxGrdDemo.Text = " "

KeyCode = 0

Case vbKeyDelete

' Удаляет символы

FlxGrdDemo.Text = " "

End Select

End Sub

Private Sub Text1_Change()

FlxGrdDemo.Rows = 1 + Text1.Text

FlxGrdDemo.Cols = 2 + Text1.Text

End Sub

Form2.frm

Private Sub Command1_Click()

Form4.Show

End Sub

Private Sub OKButton_Click()

Form1.Show

Unload Me

End Sub

Form3.frm

Private Sub Command1_Click()

Unload Form3

End Sub

Sub Eq_Sol(A() As Double, B() As Double, X() As Double, N As Integer)

Dim L(1 To 10, 1 To 10), R(1 To 10, 1 To 10), Y(1 To 10)

Dim I As Integer, j As Integer, k As Integer

For I = 1 To N

L(I, 1) = A(I, 1)

Next I

Y(1) = B(1) / A(1, 1)

For I = 2 To N

R(I, I) = 1

j = 2

Do

L(I, j) = A(I, j)

R(I, j) = 0

For k = 1 To j - 1

L(I, j) = L(I, j) - L(I, k) * R(k, j)

Next

j = j + 1

Loop Until j > I

R(I, I) = 1

Do

L(I, j) = 0

R(I, j) = A(I, j)

Y(I) = B(I)

For k = 1 To I - 1

R(I, j) = R(I, j) - L(I, k) * R(k, j)

Y(I) = Y(I) - L(I, k) * Y(k)

Next

R(I, j) = R(I, j) / L(I, I)

Y(I) = Y(I) / L(I, I)

j = j + 1

Loop Until j > N

Next

X(N) = Y(N)

For I = N - 1 To 1 Step -1

X(I) = Y(I)

For k = I + 1 To N

X(I) = X(I) - R(I, k) (k)

Next

Next

End Sub