风铃科学计算器程序代码vb.docx

1、风铃科学计算器程序代码vb风铃计算器程序代码青春风铃西南交通大学Dim sum As Double, Expr, A, B, D, Cha As StringDim Time As IntegerDim leftbracket, rbracket As IntegerDim Bo1, Bo2, Sto As BooleanPublic Function Fact(n As Long) As Double If n 0 Then If n = 1 Then Fact = 1 Else Fact = n * Fact(n - 1) End If ElseIf n = 0 Then Fact = 1

2、 Else If n = -1 Then Fact = -1 Else Fact = n * Fact(n + 1) End If End IfEnd FunctionPrivate Function leftfind(ByVal Expr As String, Where As Long) As String Dim i, leftbracket, rbracket As Integer Dim numl As String If Mid(Expr, Where - 1, 1) = ) Then -左有括号 For i = Where To 1 Step -1 If Mid(Expr, i,

3、 1) = ) Then rbracket = rbracket + 1 ElseIf Mid(Expr, i, 1) = ( Then lbracket = lbracket + 1 End If If lbracket = rbracket And lbracket 0 Then numl = Mid(Expr, i, Where - i) Exit For End If Next i Else -无括号 For i = Where - 1 To 1 Step -1 numl = Mid(Expr, i, 1) If numl = + Or numl = - Or numl = * Or

4、numl = / Or numl = ( Then numl = Mid(Expr, i + 1, Where - i - 1) Exit For End If If i = 1 Then numl = Mid(Expr, 1, Where - 1) Exit For End If Next i End If leftfind = numlEnd FunctionPrivate Function rightfind(ByVal Expr As String, Where As Long) As String Dim i, leftbracket, rbracket As Integer Dim

5、 numr As String If Mid(Expr, Where + 1, 1) = ( Then -右有括号 For i = Where + 1 To Len(Expr) If Mid(Expr, i, 1) = ) Then rbracket = rbracket + 1 ElseIf Mid(Expr, i, 1) = ( Then lbracket = lbracket + 1 End If If lbracket = rbracket And lbracket 0 Then numr = Mid(Expr, Where + 1, i - Where) Exit For End I

6、f Next i Else -无括号 For i = Where + 1 To Len(Expr) numr = Mid(Expr, i, 1) If numr = + Or numr = - Or numr = * Or numr = / Or numl = ( Then numr = Mid(Expr, Where + 1, i - Where - 1) Exit For End If If i = Len(Expr) Then numr = Mid(Expr, Where + 1, i - Where) Exit For End If Next i End If rightfind =

7、numrEnd FunctionPrivate Sub jingdian_Click(Index As Integer) Frame1.BackColor = &H8080FF Frame2.BackColor = &H80FF80 Frame3.BackColor = &HFF80FF Text2.BackColor = &H80FF80 For i = 0 To 11 Label1(i).BackColor = &HFF80FF Next i jingdian(0).Enabled = False chuantong(1).Enabled = True pinhong(2).Enabled

8、 = TrueEnd SubPrivate Sub chuantong_Click(Index As Integer) Frame1.BackColor = &H8000000F Frame2.BackColor = &H8000000F Frame3.BackColor = &H8000000F Text2.BackColor = &H8000000F For i = 0 To 11 Label1(i).BackColor = &H8000000F Next i jingdian(0).Enabled = True chuantong(1).Enabled = False pinhong(2

9、).Enabled = TrueEnd SubPrivate Sub pinhong_Click(Index As Integer) Frame1.BackColor = &HFF80FF Frame2.BackColor = &HFF80FF Frame3.BackColor = &HFF80FF Text2.BackColor = &HFF80FF For i = 0 To 11 Label1(i).BackColor = &HFF80FF Next i jingdian(0).Enabled = True chuantong(1).Enabled = True pinhong(2).En

10、abled = FalseEnd SubPrivate Sub Form_Load() A = 0: B = 0: D = 0 Sto = False: Bo = False Text1.Text = 0 Text2.Text = 青春风铃 欢迎您的使用！ jingdian(0).Enabled = False End Sub-状态栏代码-Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) StatusBar1.Panels(2).Text = 数字键End Su

11、bPrivate Sub Frame2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) StatusBar1.Panels(2).Text = 运算符End SubPrivate Sub Frame3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) StatusBar1.Panels(2).Text = 功能区，选中Shift时执行附加功能End SubPrivate Sub Command4_Mou

12、seMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) Select Case Index Case 0 StatusBar1.Panels(2).Text = 退格 Case 1 StatusBar1.Panels(2).Text = 清除 Case 2 StatusBar1.Panels(2).Text = 左括号 Case 3 StatusBar1.Panels(2).Text = 右括号 Case 4 StatusBar1.Panels(2).Text = 等于号 E

13、nd SelectEnd SubPrivate Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) StatusBar1.Panels(2).Text = 风铃计算表达式End SubPrivate Sub Text2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) StatusBar1.Panels(2).Text = 风铃计算结果End SubPrivate Sub Check1_

14、MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) StatusBar1.Panels(2).Text = 功能转换键End SubPrivate Sub Check2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) StatusBar1.Panels(2).Text = 选中为角度模式，否则为弧度模式End Sub-数字键的输入-Private Sub Command1_Click(Index As I

15、nteger) If Time 1 Then Text1.Text = 清空表达式 Time = 1 End If If Index = 9 Then Text1.Text = Text1.Text & Index ElseIf Index = 10 Then Text1.Text = Text1.Text & . Else Text1.Text = Text1.Text & pi End IfEnd Sub-运算符的输入-Private Sub Command2_Click(Index As Integer) If Time = 0 Then Text1.Text = ElseIf Time

16、 = 2 Then Text1.Text = Ans End If Time = 1 Select Case Index Case 0 Text1.Text = Text1.Text & + Case 1 Text1.Text = Text1.Text & - Case 2 Text1.Text = Text1.Text & * Case 3 Text1.Text = Text1.Text & / End SelectEnd Sub-函数功能的输入-Private Sub Command3_Click(Index As Integer) -前处理- If Index = 2 Or (Index

17、 = 8 And Check1.Value = 0) Then If Time = 2 Then Text1.Text = Ans 引用结果 End If Else If Time 1 Then Text1.Text = 清空表达式 End If End If -附加功能- If Check1.Value = 0 Then Select Case Index Case 8 1/x Text1.Text = Text1.Text & -1 Case 9 ncr Text1.Text = Text1.Text & C Case 10 npr Text1.Text = Text1.Text & P

18、Case 11 x! Text1.Text = Text1.Text & ! End Select ElseIf Check1.Value = 1 And Sto = False Then If Time 1 And Index = 11 Then Text1.Text = Ans End If Select Case Index Case 8 If Time 1 Then Text1.Text = A= Text2.Text = A Else Text1.Text = Text1.Text & A End If Case 9 If Time 1 Then Text1.Text = B= Te

19、xt2.Text = B Else Text1.Text = Text1.Text & B End If Case 10 If Time 1 Then Text1.Text = D= Text2.Text = D Else Text1.Text = Text1.Text & D End If Case 11 If Time 1 Then Text1.Text = Ans Else Text1.Text = Text1.Text & End If Sto = True End Select Else check1.value=1 and sto=1 Select Case Index Case

20、8 Text1.Text = Text1.Text & A Case 9 Text1.Text = Text1.Text & B Case 10 Text1.Text = Text1.Text & D End Select Bo = True End If If Bo = True Then Bo = False Command4_Click (4) End If -基本功能输入- If Check1.Value = 0 Then Select Case Index Case 0 幂运算 Text1.Text = Text1.Text & Case 1 平方 Text1.Text = Text

21、1.Text & 2 Case 2 立方 Text1.Text = Text1.Text & 3 Case 3 log Text1.Text = Text1.Text & ln( Case 4 sin Text1.Text = Text1.Text & sin( Case 5 cos Text1.Text = Text1.Text & cos( Case 6 tan Text1.Text = Text1.Text & tan( Case 7 lg Text1.Text = Text1.Text & lg( End Select Else Select Case Index Case 0 根式运

22、算 Text1.Text = Text1.Text & Rn( Case 1 平方根 Text1.Text = Text1.Text & (1/2) Case 2 立方根 Text1.Text = Text1.Text & (1/3) Case 3 ex Text1.Text = Text1.Text & e( Case 4 asin Text1.Text = Text1.Text & asin( Case 5 acos Text1.Text = Text1.Text & acos( Case 6 tan Text1.Text = Text1.Text & atn( Case 7 ln Tex

23、t1.Text = Text1.Text & 10( End Select End If Time = 1End Sub-常用按钮及等号的代码-Private Sub Command4_Click(Index As Integer) Dim Where As Long Dim numl, numr, str As String Dim n, r As Double Dim i, j, lbracket, rbracket As Integer Select Case Index Case 0 = 2 Then Text1.Text = Left(Text1.Text, Len(Text1.Te

24、xt) - 1) Time = 1 Else Text1.Text = 0 Time = 0 End If Case 1 AC 清零 Text1.Text = 0 Text2.Text = 0 Time = 0 sum = 0 Case 2 ( 号 If Time 1 Then Text1.Text = 清空表达式 Time = 1 End If Text1.Text = Text1.Text & ( Case 3 ) 号 If Time = 0 Then Text1.Text = 清空表达式 Time = 1 End If Text1.Text = Text1.Text & ) Case 4

25、 = 号 Expr = Replace(Text1.Text, pi, 3.14159265358979323846264338327950288419716939937510) Expr = Replace(Expr, Ans, Text2.Text) Expr = Replace(Expr, , ) Expr = Replace(Expr, =, ) Where = InStr(Expr, ) If Where 0 Then Cha = Right(Expr, 1) Expr = Left(Expr, Len(Expr) - 2) End If Expr = Replace(Expr, A

26、, A) Expr = Replace(Expr, B, B) Expr = Replace(Expr, D, D) -处理括号不足问题- For i = 1 To Len(Expr) If Mid(Expr, i, 1) = ) Then rbracket = rbracket + 1 ElseIf Mid(Expr, i, 1) = ( Then lbracket = lbracket + 1 End If Next i If lbracket rbracket Then Expr = Expr & String(lbracket - rbracket, ) End If Set Sc =

27、 CreateObject(ScriptControl) Sc.Language = VBScript -处理acos- For j = 1 To Len(Expr) Where = InStr(Expr, acos) If Where 0 Then Where = Where + 3 numr = rightfind(Expr, Where) str = acos & numr On Error GoTo eh1 r = CDbl(Sc.Eval(numr) If Check2.Value = 1 Then r = (Atn(-r / Sqr(-r * r + 1) + 2 * Atn(1) * 45 / Atn(1) ElseIf Check2.Value = 0 Then r = Atn(-r / Sqr(-r * r + 1) + 2 * Atn(1) End If Expr = Replace(Expr, str, CStr(r) i = 0: numl = : n = 0: r = 0: Where = 0: str = Else Exit For End If Next j -