VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Уравнение 0,1X^2-X*Ln(X), метод секущих хорд"
   ClientHeight    =   6465
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   9975
   LinkTopic       =   "Form1"
   ScaleHeight     =   6465
   ScaleWidth      =   9975
   StartUpPosition =   2  'CenterScreen
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000018&
      Height          =   6375
      Left            =   120
      ScaleHeight     =   6315
      ScaleWidth      =   6315
      TabIndex        =   11
      Top             =   0
      Width           =   6375
   End
   Begin VB.Frame Frame1 
      Caption         =   "Входные данные и результаты"
      Height          =   5415
      Left            =   6720
      TabIndex        =   0
      Top             =   0
      Width           =   3135
      Begin VB.TextBox Text5 
         Height          =   285
         Left            =   120
         Locked          =   -1  'True
         TabIndex        =   9
         Top             =   4920
         Width           =   2775
      End
      Begin VB.TextBox Text2 
         Height          =   285
         Left            =   1320
         TabIndex        =   8
         Top             =   720
         Width           =   1095
      End
      Begin VB.TextBox Text1 
         Height          =   285
         Left            =   1320
         TabIndex        =   7
         Top             =   360
         Width           =   1095
      End
      Begin VB.TextBox Text4 
         Height          =   2565
         Left            =   120
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   1  'Horizontal
         TabIndex        =   4
         Top             =   1920
         Width           =   2775
      End
      Begin VB.TextBox Text3 
         Height          =   285
         Left            =   1320
         TabIndex        =   3
         Top             =   1080
         Width           =   1095
      End
      Begin VB.Label Label5 
         Caption         =   "Число итераций при решении"
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   4560
         Width           =   2295
      End
      Begin VB.Label Label2 
         Caption         =   "Значение X1"
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   720
         Width           =   975
      End
      Begin VB.Label Label1 
         Caption         =   "Эначение X0"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label4 
         Caption         =   "Результаты решения"
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   1560
         Width           =   1815
      End
      Begin VB.Label Label3 
         Caption         =   "Точность E"
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   1080
         Width           =   975
      End
   End
   Begin VB.Menu file 
      Caption         =   "Файл"
      Begin VB.Menu solve 
         Caption         =   "Решить"
      End
   End
   Begin VB.Menu Save 
      Caption         =   "Сохранить"
      Begin VB.Menu save_itogi 
         Caption         =   "Сохранить результат"
      End
      Begin VB.Menu save_grafik 
         Caption         =   "Сохранить график"
      End
   End
   Begin VB.Menu exit 
      Caption         =   "Выход"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Const ItogFile As String = "Itogi.txt"
'Private Const BitmapFile As String = "Mygraf.bmp"

Private Const N_MaxCicle = 100 '"максимальное число итераций"
Private Const MinEps = 0.0000001
Private Const MaxEps = 0.1
Private Const N_Tabulat As Double = 100

Private Const MinimumX As Double = 0.1
Private Const MaximumX As Double = 2.5
Private Const MinDeltaX As Double = 0.5
Private Const ErrorValue As Double = -10000

Dim xn As Double, xk As Double, xitg As Double
Dim yn As Double, yk As Double, yy As Double
Dim epsilon As Double

Private Sub exit_Click()
End
End Sub

Private Sub Form_Load()
Text1 = 1: Text2 = 2: Text3 = 0.00001
Text1.ToolTipText = "от " & MinimumX & " до " & MaximumX
Text2.ToolTipText = "от " & MinimumX & " до " & MaximumX
Text3.ToolTipText = "от " & MinEps & " до " & MaxEps
End Sub

Private Function FuncY_X(xx As Double) As Double
Rem "вычисление функции Y(x)"
On Error GoTo HandlerError
FuncY_X = 0.1 * xx * xx - xx * Log(xx)
HandlerError:
If Err <> 0 Then
 Err.Clear: FuncY_X = ErrorValue
End If
End Function

Private Function DifFY_X(xx As Double) As Double
Rem "вычисление производной от функции Y(x)"
On Error GoTo HandlerError
DifFY_X = 0.2 * xx - Log(xx) - 1
HandlerError:
If Err <> 0 Then
 Err.Clear: DifFY_X = ErrorValue
End If
End Function

Private Function ProverDataPolz() As Boolean
Dim tmp As Double
On Error GoTo HandlerError
If Text1 = "" Or Text2 = "" Or Text3 = "" Then Exit Function
epsilon = CDbl(Text3.Text)
If epsilon > MaxEps Or epsilon < MinEps Then Exit Function
xn = CDbl(Text1.Text)
If xn < MinimumX Or xn > MaximumX Then Exit Function
xk = CDbl(Text2.Text)
If xk < MinimumX Or xk > MaximumX Then Exit Function
If xk = xn Then Exit Function
If xk < xn Then
 tmp = xk: xk = xn: xn = tmp: Text1 = xn: Text2 = xk
End If
If Abs(xk - xn) < MinDeltaX Then Exit Function
ProverDataPolz = True
HandlerError:
If Err <> 0 Then
 Err.Clear
End If
End Function

Private Sub GrafFunction()
Dim i As Double
Dim t As Double  '"шаг построения"
Dim ta As Double  '"текущий аргумент"
Dim x0 As Single, y0 As Single, x1 As Single, y1 As Single
Dim xcnt As Double, ycnt As Double, vpole As Double, gpole As Double
Dim shag_x As Double, shag_y As Double
Dim dzsy As Double, dzsx As Double
Dim masht_x As Double, masht_y As Double
Dim xn As Double, xk As Double
On Error GoTo HandlerError
If ProverDataPolz = False Then Exit Sub
Picture1.Cls
Rem "устанавливаем масштаб"
masht_x = 2.5: masht_y = 2.5
shag_x = masht_x / 5: shag_y = masht_y / 5
vpole = 0.1 * masht_y: gpole = 0.1 * masht_x
Picture1.ScaleWidth = masht_x * 1.2
Picture1.ScaleHeight = masht_y * 1.2
dzsy = Picture1.ScaleHeight * 0.01
dzsx = Picture1.ScaleWidth * 0.01
xcnt = gpole: ycnt = vpole + masht_x / 5
Rem "рисуем координатные линии"
Picture1.Line (0, ycnt)-(Picture1.ScaleWidth, ycnt)
Picture1.Line (xcnt, 0)-(xcnt, Picture1.ScaleHeight)
Rem "рисуем засечки"
For i = gpole To Picture1.ScaleWidth - 0.9 * gpole Step shag_x
 If i <> xcnt Then
 Picture1.Line (i, ycnt)-(i, ycnt - dzsy)
 Picture1.CurrentX = i - dzsx: Picture1.CurrentY = ycnt + dzsy
 Picture1.Print i - gpole
 End If
Next i
Picture1.CurrentX = Picture1.ScaleWidth * 0.96
Picture1.CurrentY = ycnt - Picture1.ScaleHeight * 0.03
Picture1.Print "X"
For i = vpole To Picture1.ScaleHeight - 0.9 * vpole Step shag_y
 If i <> ycnt Then
 Picture1.Line (xcnt, i)-(xcnt + dzsx, i)
 Picture1.CurrentX = xcnt + dzsx
 Picture1.CurrentY = i - 0.01 * Picture1.ScaleHeight
 Picture1.Print 0.75 - i
 End If
Next i
Picture1.CurrentX = xcnt + dzsx
Picture1.CurrentY = 0.01 * Picture1.ScaleHeight
Picture1.Print "Y"
Rem "xn и xk пределы построения функции"
Picture1.ForeColor = QBColor(12)
xn = CDbl(Text1.Text): xk = CDbl(Text2.Text)
If Abs(FuncY_X(xitg)) <= epsilon Then
 If xk < xitg Then xk = xitg + 0.2
 If xn > xitg Then xn = xitg - 0.2
End If
t = (Abs(xk - xn)) / N_Tabulat
x0 = xcnt + xn: ta = xn
y0 = ycnt - FuncY_X(ta)
Do While ta <= xk
 x1 = x0 + t: ta = ta + t
 If ta > xk Then Exit Do  '"чтобы лишнего не строить"
 y1 = ycnt - FuncY_X(ta)
 Picture1.Line (x0, y0)-(x1, y1)
 x0 = x1: y0 = y1
Loop
Picture1.ForeColor = QBColor(0)
Picture1.CurrentX = 0.4
Picture1.CurrentY = 0.01 * Picture1.ScaleHeight
Picture1.Print "График функции 0,1*X^2 - X*Ln(X);  [" _
& Format(xn, "0.00") & ".." & Format(xk, "0.00") & "]"
HandlerError:
If Err <> 0 Then
 Err.Clear
End If
End Sub

Private Sub Picture1_Click()
Picture1.Cls
End Sub

Private Sub save_grafik_Click()
Form2.Show
End Sub

Private Sub save_itogi_Click()
Form3.Show
End Sub

Private Sub solve_Click()
Dim x As Double, j As Long
On Error GoTo HandlerError
xitg = 0
Text4 = "": Text5.Text = "": Picture1.Cls
If ProverDataPolz = False Then Exit Sub
j = 0
Do While Abs(Abs(xk) - Abs(xn)) > epsilon
 yn = FuncY_X(xn)
 If yn = ErrorValue Then Exit Do
 yk = FuncY_X(xk)
 If yk = ErrorValue Then Exit Do
 yy = DifFY_X(xk)
 If yy = ErrorValue Then Exit Do
 j = j + 1
 Rem "визуализация вычислений"
 If Abs(yn) < Abs(yk) Then
  x = xn
 Else
  x = xk
 End If
 Text4.Text = Text4.Text & CStr(j) & " приближение корня X = " _
 & Format(x, "0.000 000 000") & vbCrLf
 Text5 = j
 Rem "вычисление очередной итерации"
 xn = xk - ((xn - xk) * yk) / (yn - yk)
 xk = xk - (yk / yy)
 Rem "от зацикливания"
 If j > N_MaxCicle Then Exit Do
Loop
j = j + 1
yn = FuncY_X(xn)
yk = FuncY_X(xk)
If Abs(yn) < Abs(yk) Then
 x = xn
Else
 x = xk
End If
Text4.Text = Text4.Text & CStr(j) & " приближение корня X = " _
& Format(x, "0.000 000 000") & vbCrLf
If Abs(Abs(xk) - Abs(xn)) > epsilon Then
 Text4.Text = Text4.Text & "На заданном интервале корня нет" & vbCrLf
Else
 Text4.Text = Text4.Text & "Окончательное значение корня X = " _
 & Format(x, "0.000 000 000") & vbCrLf
End If
xitg = x
Text5 = j
GrafFunction
HandlerError:
If Err <> 0 Then
 Err.Clear
 Text4.Text = Text4.Text & "На заданном интервале корня нет" & vbCrLf
 Text4.Text = Text4.Text & "Ошибка в вычислениях" & vbCrLf
 Text4.Text = Text4.Text & "Неверно задан интервал" & vbCrLf
End If
End Sub