Attribute VB_Name = "mdlGeneral"
Public Const Read_outcome As String = "Outcome.txt"
Public Const Look_chart As String = "Chart.bmp"
Public File As String

Public Const MinimumX As Double = 0.001 'минимальное значение аргумента X (=0,001)
Public Const MaximumX As Double = 2.75 'максимальное значение аргумента X (=2,75)
Public Const MinEps As Double = 0.000000000000001 'минимальное значение точность вычислений (=10^-15)
Public Const MaxEps As Double = 1 'максимальное значение точность вычислений (=10^0)
Public Const MinDeltaX As Double = 0.01 'минимальная разница между начальным и конечным значениями аргумента X (=0,01)
Public Const MaxIterations As Integer = 100 'максимальное число итераций (приближений) (=100)

Public x As Double, y As Double 'переменные задания аргумента и функции
Public x1 As Double, x2 As Double 'переменные задания изменяемого значения корня (решения) при первом и втором приближении
Public xn As Double, xk As Double 'переменные задания начального и конечного значений аргумента X на заданном (начальном) отрезке
Public xn1 As Double, xk1 As Double 'переменные задания изменяемых начального и конечного значений аргумента X на оставшемся отрезке
'Public yn As Double, yk As Double, yy As Double
'Public xitg As Double 'переменная задания итогового значения аргумента X

Public t1 As String 'переменная задания первого текстового окна для ввода начального значения аргумента X (xn)
Public t2 As String 'переменная задания второго текстового окна для ввода конечного значения аргумента X (xk)
Public t3 As String 'переменная задания третьего текстового окна для ввода необходимой точности вычислений (Epsilon)
Public KeyAscii As Integer 'переменная задания для запоминания номера клавиши, при нажатии на которую выполняются указанные действия
Public Epsilon As Double 'переменная задания необходимой точности вычислений
Public Iterations As Integer 'переменная задания числа итераций (приближений)
'Public Chorda As Double 'переменная задания результата вычислений функции/решения (наиболее точного) при его вычислении методом хорд
Public MasXn1(1 To 100) As Double 'задание массива последовательных значений аргумента (Xn1) начал хорд (отрезков)
Public MasXk1(1 To 100) As Double 'задание массива последовательных значений аргумента (Xk1) концов хорд (отрезков)
Public j As Integer 'переменная, необходимая для выполнения действий в цикле
Public l As Integer 'переменная, необходимая для выполнения действий в цикле

Public Function Func(x) As Double
Rem "Задание функции (уравнения) y=0,1x^2-xln(x)" _
<Вот оно уравнение (Uravnenie)!!! Посмотрите на него!!!>
Func = 0.1 * x * x - x * Log(x)
'Func = 0.2 * x - Log(x) - 1
End Function

'Public Function Diff(x) As Double
'Rem "Задание производной функции y'=0,2x-ln(x)-1"
'Diff = 0.2 * x - Log(x) - 1
'End Function

Public Function CheckOfEnteredData() As Boolean
Rem "Задание функции проверки вводимых данных и их достоверности"

'Проверка наличия данных в текстовых полях
If t1 = "" Or t2 = "" Or t3 = "" Then
MsgBox "Введите начальное и конечное значения" & Chr(13) & Chr(10) & "     аргумента и точность вычислений!", vbCritical, "Ошибка ввода данных"
Exit Function 'условия для завершения функции при незаполенных или неправильно заполненных текстовых полях с данными
End If

Dim Bukvy As Boolean 'переменная для определения наличия букв в текстовых полях
Dim n1 As Integer, n2 As Integer, n3 As Integer 'переменные задания определения количества символов в текстовых полях соответственно
n1 = Len(t1): n2 = Len(t2): n3 = Len(t3) 'вычисление количества символов в текстовых полях
ReDim s1(1 To n1) As String
ReDim s2(1 To n2) As String
ReDim s3(1 To n3) As String
'задание массивов для присваивания в них значений каждого символа из текстовых полей
Bukvy = False 'среди введённых символов букв нет
'Проверка содержимого первого текстового поля
For j = 1 To n1
s1(j) = Mid(t1, j, 1) 'посимвольное разбиение строки в первом текстовом поле и присвоение к массиву подстрок
 If ((s1(j) >= "0") And (s1(j) <= "9")) Or (s1(j) = ",") Or (s1(j) = "E") Or (s1(j) = "-") Then
 'пустое условие означает выполнение следуюших операций
 Else: Bukvy = True 'среди введённых символов есть буквы
 Exit For 'досрочный выход из цикла
 End If
Next
'Проверка содержимого второго текстового поля
For j = 1 To n2
s2(j) = Mid(t2, j, 1) 'посимвольное разбиение строки во втором текстовом поле и присвоение к массиву подстрок
 If ((s2(j) >= "0") And (s2(j) <= "9")) Or (s2(j) = ",") Or (s2(j) = "E") Or (s2(j) = "-") Then
 'пустое условие означает выполнение следуюших операций
 Else: Bukvy = True 'среди введённых символов есть буквы
 Exit For 'досрочный выход из цикла
 End If
Next
'Проверка содержимого третьего текстового поля
For j = 1 To n3 'посимвольное разбиение строки в третьем текстовом поле и присвоение к массиву подстрок
s3(j) = Mid(t3, j, 1)
 If ((s3(j) >= "0") And (s3(j) <= "9")) Or (s3(j) = ",") Or (s3(j) = "E") Or (s3(j) = "-") Then
 'пустое условие означает выполнение следуюших операций
 Else: Bukvy = True 'среди введённых символов есть буквы
 Exit For 'досрочный выход из цикла
 End If
Next
'Вывод результата о символах во всех трёх текстовых полях
If Bukvy = True Then
MsgBox "Варажение должно содержать" & Chr(13) & Chr(10) & "    только числовые данные!", vbCritical, "Ошибка ввода данных"
Exit Function
'условия для завершения функции при наличии нечисловых данных в каком-либо из трёх текстовых поей
End If

'Проверка значений текстоых окон
'CDbl - конвентирует строчное выражение (String) в Double; наподобие функции Val - возвращение числового значения из строки
xn = CDbl(t1) 'присвоение переменной xn значения, введённого в первом текстовом поле для задания начального значения аргумента X
If xn < MinimumX Or xn > MaximumX Then
MsgBox "Введённое значение недопустимо!", vbCritical, "Ошибка ввода данных"
Exit Function
'условия для завершения функции при введении недопустимых значений xn
End If

xk = CDbl(t2) 'присвоение переменной xk значения, введённого во втором текстовом поле для задания конечного значения аргумента X
If xk < MinimumX Or xk > MaximumX Then
MsgBox "Введённое значение недопустимо!", vbCritical, "Ошибка ввода данных"
Exit Function
'условия для завершения функции при введении недопустимых значений xk
End If

Epsilon = CDbl(t3) 'присвоение переменной epsilon значения введённого в третем текстовом поле для задания точности вычислений
If Epsilon > MaxEps Or Epsilon < MinEps Then
MsgBox "Введённое значение недопустимо!", vbCritical, "Ошибка ввода данных"
Exit Function
'условия для завершения функции при введении недопустимых значений epsilon
End If

If xk = xn Then
MsgBox " Начальное и конечное значения" & Chr(13) & Chr(10) & "аргумента не должны совпадать!", vbCritical, "Ошибка ввода данных"
Exit Function
'условие для завершения функции при совпадении начального и конечного значений аргумента X
End If

Dim tmp As Double 'задание переменной для временного запоминания конечного значения аргумента (переменная xk) при переприсваивании
If xk < xn Then
'условие для переприсваивания конечного и начального значений аргумента
 tmp = xk: xk = xn: xn = tmp: t1 = xn: t2 = xk
End If

If Abs(xk - xn) < MinDeltaX Then
MsgBox "    Разница между начальным и конечным" & Chr(13) & Chr(10) & "значениями аргумента пренебрежимо мала!", vbCritical, "Ошибка ввода данных"
Exit Function
'условие для завершения функции при пренебрежимо малой разнице начального и конечного значений аргумента X
End If
CheckOfEnteredData = True
Rem "Если все условия, указанные в этой функции не выполняются, то CheckOfEnteredData принимает положительное значение"
End Function

Public Function Chord(xn, xk, Epsilon) As Double

Rem "Задание функции для решения данного нелинейного уравнения методом хорд"
Dim Razn As Double 'переменная задания разности приближённых решений (x2-x1)
Iterations = 0 'зануление числа итераций (приближений)
xn1 = xn 'присвоение переменной задания начального значения X на оставшемся отрезке значения на начальном отрезке
xk1 = xk 'присвоение переменной задания конечного значения X на оставшемся отрезке значения на начальном отрезке
x1 = 0 'зануление изменяемого значения корня (решения) при первом приближении
x2 = 0 'зануление изменяемого значения корня (решения) при втором приближении
l = 1 'указание начального значения счётчика приближений (итераций)
MasXn1(l) = xn1 'присвоение первого элемента массиву последовательных значений аргумента (Xn1) начал хорд (отрезков)
MasXk1(l) = xk1 'присвоение первого элемента массиву последовательных значений аргумента (Xk1) концов хорд (отрезков)
Do
Rem "Задание цикла обработки (сравнения и переприсвоения значений) каждого приблежения _
для нахождения решения заданного уравнения на указанном интервале с указанной точностью"
 If l > MaxIterations Then Exit Do 'условие для выхода из цикла в случае зацикливания и глобального _
 зависания из-за неверно введённой точности. [Если не изменять максимальную и минимальную границу _
 значения точности Epsilon, то это условие никогда не выполнится.]
 
 x1 = xn1 - (xk1 - xn1) * Func(xn1) / (Func(xk1) - Func(xn1))
 'формула нахождения изменяемого значения X решения при первом приближении
 
 If Func(xn1) * Func(xk1) > 0 Then 'условие для определения наличия корня на указанном интервале
 MsgBox "На заданном интер-" & vbCrLf & "   вале корня нет!", vbInformation, "Решений нет!"
 frmChart.Option1.Enabled = False 'Выключение ненужных в данном случае элементов
 frmChart.Option2.Enabled = False '(При отсутствии корня уравнения хорды не рисуются)
 Rem "Вывод сообщении об отсутствии корня уравнения на указанним интервале"
 frmChart.RichTextBox1.Text = frmChart.RichTextBox1.Text & "На заданном интервале корня нет! Y не равен 0!"
 Exit Function 'выход из функции для решения данного нелинейного уравнения методом хорд
 End If
 
 Rem "Вывод промежуточных значений координаты x1/приближённых решений данного уравнения на каждой итерации (приближении)
 frmChart.RichTextBox1.Text = frmChart.RichTextBox1.Text & CStr(l) & "-е приближение корня x=" _
 & Format(x1, "0.000 000 000 000 000") & vbCrLf 'vbCrLf - стандартная функция VB6, эсквивалентная значению Chr(13) & Chr(10)
 
 l = l + 1 'увеличение значений счётчика при каждом очередном приближении
 MasXn1(l) = x1 'присвоение элементам массива MasXn1 изменяемых значений X решений (нулей функции)
 
 If Func(x1) = 0 Then Exit Do 'условие для выхода из цикла при первом точном нахождении решении
 If Func(xn1) * Func(x1) < 0 Then
 'условие для определения знака значения функции на отрезке [xn1,x1]
  xk1 = x1 'присвоение конечной координате X оставшегося отрезка значения X при первом приближении
  MasXk1(l) = xn 'присвоение элементам массива MasXk1 значений начальной координаты X заданного отрезка
  Else
  xn1 = x1 'присвоение начальной координате X оставшегося отрезка значения X при первом приближении
  MasXk1(l) = xk 'присвоение элементам массива MasXk1 значений конечной координаты X заданного отрезка
 End If
 
 Razn = Abs(x2 - x1) 'вычисление разности приближённых решений (x2-x1); при первом проходе Razn=|0-x1|
 x2 = x1 'переприсвоение значений x2 для вычисления более точного решения x3 при очередном приближении (итерации)
Loop Until Razn <= Epsilon 'условие завершения цикла приближений: разность смежных решений (x2-x1) не должна превышать заданной точности

frmChart.RichTextBox1.Text = frmChart.RichTextBox1.Text & "Окончательное значение корня при заданной точности x=" _
& Format(x1, "0.000 000 000 000 000") 'вывод последнего значения координаты x1/решения данного уравнения
Iterations = l - 1 'присвоение конечного значения счётчика приближений (итераций) переменной числа итераций (приближений)
Chord = x1 'присвоение последнего значения координаты x1 результау вычислений функции/решению данного уравнения
End Function 'завершение функции для решения данного нелинейного уравнения методом хорд