📄 main form.frm
字号:
Top = 615
Width = 1080
End
Begin VB.Shape Shape1
FillColor = &H00000040&
Height = 4080
Left = 8280
Shape = 4 'Rounded Rectangle
Top = 480
Width = 1230
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H00808080&
Caption = "Scale"
ForeColor = &H00FF0000&
Height = 195
Left = 8640
TabIndex = 3
Top = 645
Width = 435
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public t As String
Public X, ultimpoz As Double
Public ss1, ss2 As String
Public nr, nn, scala, cresc, iis As Integer
Public infinit, fass As Boolean
Public nedef As Boolean
Public jj As Long
Public startprog As Boolean
Private texte(1 To 9), intervale(1 To 9) As String
Private Sub progr(ByVal X As Integer)
Dim i, Y As Integer
Y = (251 / 525) * (X - 5)
Progress.Line (Y, 0)-(Y, 22), RGB(0, 0, 150)
End Sub
Public Sub calculurm(ByVal sir As String, ByRef sirrez As String, Optional ByVal frac As Integer)
Dim subsir, S As String
Dim c As String
Dim k, i As Byte
For i = 1 To Len(sir)
k = i
c = Mid(sir, i, 1)
subsir = subsir + c
Select Case subsir
Case " "
subsir = ""
Case "x", "e"
sirrez = subsir
Exit For
Case "0" To "9"
For j = i + 1 To Len(sir)
c = Mid(sir, j, 1)
If (c >= "0" And c <= "9") Or (c = ".") Then
subsir = subsir + c
i = j
Else
Exit For
End If
Next
sirrez = subsir
Exit For
Case "("
If fass = True Then
subsir = "("
Else
subsir = ""
End If
nr = 1
For j = i + 1 To Len(sir)
c = Mid(sir, j, 1)
If c = ")" Then
nr = nr - 1
If nr = 0 Then
If fass = True Then
subsir = subsir + c
End If
Exit For
Else
i = i + 1
subsir = subsir + c
End If
ElseIf c = "(" Then
nr = nr + 1
subsir = subsir + c
i = i + 1
Else
subsir = subsir + c
i = i + 1
End If
Next
sirrez = subsir
Exit Sub
Case "|"
If fass = True Then
subsir = "|"
Else
subsir = ""
End If
nr = 1
For j = i + 1 To Len(sir)
c = Mid(sir, j, 1)
If c = "|" Then
c = Mid(sir, j - 1, 1)
If c = "*" Or c = "+" Or c = "-" Or c = "/" Or c = ":" Or c = "|" Or c = "(" Then
nr = nr + 1
subsir = subsir + "|"
ElseIf c = "a" Then
c = Mid(sir, j - 2, 2)
If c = "^" Then
nr = nr + 1
subsir = subsir + "|"
End If
Else
nr = nr - 1
If nr = 0 Then
If fass = True Then
subsir = subsir + "|"
End If
Exit For
End If
End If
Else
subsir = subsir + c
End If
Next
sirrez = subsir
Exit Sub
Case "sin(", "cos(", "tg(", "arctg(", "arcsin(", "arccos(", "arctg(", "arcctg("
nr = 1
For j = i + 1 To Len(sir)
c = Mid(sir, j, 1)
If c = ")" Then
nr = nr - 1
If nr = 0 Then
subsir = subsir + ")"
Exit For
Else
subsir = subsir + c
i = i + 1
End If
ElseIf c = "(" Then
nr = nr + 1
subsir = subsir + c
i = i + 1
Else
subsir = subsir + c
i = i + 1
End If
Next
sirrez = subsir
Exit For
Case "radical("
nr = 1
For j = i + 1 To Len(sir)
c = Mid(sir, j, 1)
If c = ")" Then
nr = nr - 1
If nr = 0 Then
subsir = subsir + ")"
Exit For
Else
subsir = subsir + c
i = i + 1
End If
ElseIf c = "(" Then
nr = nr + 1
subsir = subsir + c
i = i + 1
Else
subsir = subsir + c
i = i + 1
End If
Next
sirrez = subsir
Exit For
Case "ln"
ss1 = Mid(sir, Len(sir) - i)
Call calculurm(ss1, S)
sirrez = subsir + S
c = Mid(sir, i + 1, 1)
i = Len(sirrez)
If c = "(" Then
i = i + 2
End If
subsir = ""
Exit Sub
End Select
Next
If frac <> 15 Then
i = i + 1
c = Mid(sir, i, 1)
If c = "*" Or c = "/" Or c = ":" Then
i = i + 1
ss1 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss1, S)
subsir = subsir + c + S
sirrez = subsir
ElseIf c = "l" Then
c = Mid(sir, i, 2)
If c = "" Then
i = i + 2
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
subsir = subsir + c + S
sirrez = subsir
End If
End If
End If
End Sub
Public Sub subfunctie(ByVal sir As String, ByRef vall As Double)
Dim subsir, c, secsir, S As String
Dim rez As Double
Dim rez2 As Double
Dim i, j, nr As Integer
subsir = ""
vall = 0
For i = 1 To Len(sir)
c = Mid(sir, i, 1)
subsir = subsir + c
Select Case subsir
Case " "
subsir = ""
Case "("
ss2 = Mid(sir, i, Len(sir) + 1)
fass = False
Call calculurm(ss2, S)
fass = True
Call subfunctie(S, rez)
vall = rez
i = i + Len(S) + 1
subsir = ""
Case "|"
ss2 = Mid(sir, i, Len(sir) + 1)
fass = False
Call calculurm(ss2, S)
fass = True
Call subfunctie(S, rez)
vall = Abs(rez)
i = i + Len(S) + 1
subsir = ""
Case "x"
vall = X
subsir = ""
Case "e"
vall = 2.718282
subsir = ""
Case "+"
ss2 = Mid(sir, i + 1, Len(sir) - i)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
vall = vall + rez
i = i + Len(S)
subsir = ""
Case "-"
ss2 = Mid(sir, i + 1, Len(sir) - i)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
vall = vall - rez
i = i + Len(S)
subsir = ""
Case "0" To "9"
For j = i + 1 To Len(sir)
c = Mid(sir, j, 1)
If (c >= "0" And c <= "9") Or (c = ".") Then
subsir = subsir + c
i = i + 1
Else
Exit For
End If
Next
vall = Val(subsir)
subsir = ""
Case "*"
ss2 = Mid(sir, i + 1, Len(sir) - i)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
vall = vall * rez
i = i + Len(S)
subsir = ""
Case "/", ":"
ss2 = Mid(sir, i + 1, Len(sir) - i)
Call calculurm(ss2, S, 15)
Call subfunctie(S, rez)
If rez = 0 Then
nedef = True
Exit Sub
Else
vall = vall / rez
End If
i = i + Len(S)
subsir = ""
Case "^"
ss2 = Mid(sir, i + 1, Len(sir) - i)
Call calculurm(ss2, S, 15)
Call subfunctie(S, rez)
jj = Int(rez)
If ((vall < 0) And (rez <> jj)) Then
nedef = True
Exit Sub
Else
If (vall = 0) And (rez < 0) Then
nedef = True
Exit Sub
Else
vall = vall ^ rez
End If
End If
i = i + Len(S)
subsir = ""
Case "sin("
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
vall = Sin(rez)
i = i + Len(S) - 1
subsir = ""
Case "arcsin("
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
If -rez * rez + 1 > 0 Then
vall = Atn(rez / Sqr(-rez * rez + 1))
Else
nedef = True
End If
i = i + Len(S) - 1
subsir = ""
Case "arccos("
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
If -rez * rez + 1 > 0 Then
vall = Atn(-rez / Sqr(-rez * rez + 1)) + 2 * Atn(1)
Else
nedef = True
End If
i = i + Len(S) - 1
subsir = ""
Case "arctg("
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
vall = Atn(rez)
i = i + Len(S) - 1
subsir = ""
Case "arcctg("
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
vall = Atn(rez) + 2 * Atn(1)
i = i + Len(S) - 1
subsir = ""
Case "cos("
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
vall = Cos(rez)
i = i + Len(S) - 1
subsir = ""
Case "tg("
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
If Cos(X) = 0 Then
nedef = True
Else
vall = Sin(X) / Cos(X)
End If
i = i + Len(S) - 1
subsir = ""
Case "ctg("
ss2 = Mid(sir, i, Len(sir) - i + 1)
Call calculurm(ss2, S)
Call subfunctie(S, rez)
If Sin(X) = 0 Then
nedef = True
Else
vall = Cos(X) / Sin(X)
End If
i = i + Len(S) - 1
subsir = ""
Case "radical("
ss2 = Mid(sir, i + 1, Len(sir) - i + 1)
S = ""
nr = 0
rez2 = 0
j = 1
c = Mid(ss2, j, 1)
While ((nr <> 0) Or (c <> ",")) And (j <= Len(ss2))
S = S + c
j = j + 1
c = Mid(ss2, j, 1)
If c = "(" Then
nr = nr + 1
End If
If c = ")" Then
nr = nr - 1
End If
Wend
Call subfunctie(S, rez2)
i = i + j + 1
ss2 = Mid(sir, i, Len(sir) - i + 1)
S = ""
nr = 0
j = 1
c = Mid(ss2, j, 1)
While (nr <> -1) And (j <= Len(ss2))
S = S + c
j = j + 1
c = Mid(ss2, j, 1)
If c = "(" Then
nr = nr + 1
End If
If c = ")" Then
nr = nr - 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -