《2022年风铃科学计算器程序代码 .pdf》由会员分享，可在线阅读，更多相关《2022年风铃科学计算器程序代码 .pdf（14页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、风铃计算器程序代码青春风铃西南交通大学名师资料总结-精品资料欢迎下载-名师精心整理-第 1 页，共 14 页 -Dim sum As Double,Expr,A,B,D,Cha As String Dim Time As Integer Dim leftbracket,rbracket As Integer Dim Bo1,Bo2,Sto As Boolean 名师资料总结-精品资料欢迎下载-名师精心整理-第 2 页，共 14 页 -Public Function Fact(n As Long)As Double If n 0 Then If n=1 Then Fact=1 Else Fact
2、=n*Fact(n-1)End If ElseIf n=0 Then Fact=1 Else If n=-1 Then Fact=-1 Else Fact=n*Fact(n+1)End If End If End Function Private Function leftfind(ByV al 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-
3、1 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 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 numl=/Or numl=(Then numl=Mid(Ex
4、pr,i+1,Where-i-1)Exit For End If If i=1 Then numl=Mid(Expr,1,Where-1)Exit For 名师资料总结-精品资料欢迎下载-名师精心整理-第 3 页，共 14 页 -End If Next i End If leftfind=numl End Function Private Function rightfind(ByV al Expr As String,Where As Long)As String Dim i,leftbracket,rbracket As Integer Dim numr As String If Mid(
5、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 If Next i Else-无括号For i=Where+1 To Len(Expr)numr=Mid(Expr,i,1)If nu
6、mr=+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=numr End Function Private Sub jingdian_Click(Index As Integer)Frame1.BackColor=&H8080FF Frame2.BackColor=&H80FF80 Fram
7、e3.BackColor=&HFF80FF Text2.BackColor=&H80FF80 For i=0 To 11 Label1(i).BackColor=&HFF80FF Next i 名师资料总结-精品资料欢迎下载-名师精心整理-第 4 页，共 14 页 -jingdian(0).Enabled=False chuantong(1).Enabled=True pinhong(2).Enabled=True End Sub Private Sub chuantong_Click(Index As Integer)Frame1.BackColor=&H8000000F Frame2.Ba
8、ckColor=&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).Enabled=True End Sub Private Sub pinhong_Click(Index As Integer)Frame1.BackColor=&HFF80FF Frame2.BackColor=&HFF
9、80FF 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).Enabled=False End Sub Private Sub Form_Load()A=0:B=0:D=0 Sto=False:Bo=False Text1.Text=0 Text2.Text=青春风铃欢迎您的使用！jingdian(0).Enabled=F
10、alse End Sub-状态栏代码-Private Sub Frame1_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)StatusBar1.Panels(2).Text=数字键 End Sub 名师资料总结-精品资料欢迎下载-名师精心整理-第 5 页，共 14 页 -Private Sub Frame2_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)StatusBar1.Panels(2).Text=运算符
11、End Sub Private Sub Frame3_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)StatusBar1.Panels(2).Text=功能区，选中Shift 时执行附加功能End Sub Private Sub Command4_MouseMove(Index As Integer,Button As Integer,Shift As Integer,X As Single,Y As Single)Select Case Index Case 0 StatusBar1.Panels(2
12、).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=等于号 End Select End Sub Private Sub Text1_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)StatusBar1.Panels(2).Text=风铃计算表达式 End
13、 Sub Private Sub Text2_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)StatusBar1.Panels(2).Text=风铃计算结果 End Sub Private Sub Check1_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)StatusBar1.Panels(2).Text=功能转换键 End Sub Private Sub Check2_MouseMove(Button As
14、Integer,Shift As Integer,X As Single,Y As Single)StatusBar1.Panels(2).Text=选中为角度模式，否则为弧度模式 End Sub-数字键的输入-Private Sub Command1_Click(Index As Integer)If Time 1 Then 名师资料总结-精品资料欢迎下载-名师精心整理-第 6 页，共 14 页 -Text1.Text=清空表达式Time=1 End If If Index=9 Then Text1.Text=Text1.Text&Index ElseIf Index=10 Then Tex
15、t1.Text=Text1.Text&.Else Text1.Text=Text1.Text&pi End If End Sub-运算符的输入-Private Sub Command2_Click(Index As Integer)If Time=0 Then Text1.Text=ElseIf Time=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&*Ca
16、se 3 Text1.Text=Text1.Text&/End Select End Sub-函数功能的输入-Private Sub Command3_Click(Index As Integer)-前处理-If Index=2 Or(Index=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 名师资料总结-精品资料欢迎下载-名师精心整理-第 7 页，共 14 页 -附加功能-If Check1.Value=0
17、 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 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
18、 Then Text1.Text=A=Text2.Text=A Else Text1.Text=Text1.Text&A End If Case 9 If Time 1 Then Text1.Text=B=Text2.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.Tex
19、t&End If 名师资料总结-精品资料欢迎下载-名师精心整理-第 8 页，共 14 页 -Sto=True End Select Else check1.value=1 and sto=1 Select Case Index Case 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.
20、Value=0 Then Select Case Index Case 0 幂运算Text1.Text=Text1.Text&Case 1 平方Text1.Text=Text1.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=Tex
21、t1.Text&lg(End Select Else Select Case Index Case 0 根式运算Text1.Text=Text1.Text&Rn(Case 1 平方根Text1.Text=Text1.Text&(1/2)名师资料总结-精品资料欢迎下载-名师精心整理-第 9 页，共 14 页 -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&a
22、cos(Case 6 tan Text1.Text=Text1.Text&atn(Case 7 ln Text1.Text=Text1.Text&10(End Select End If Time=1 End 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 Tex
23、t1.Text=Left(Text1.Text,Len(Text1.Text)-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&(名师资料总结-精品资料欢迎下载-名师精心整理-第 10 页，共 14 页 -Case 3)号If Time=0 Then Text1.Text=清空表达式Time=1 End If T
24、ext1.Text=Text1.Text&)Case 4=号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,A)Expr=Repla
25、ce(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=CreateObject(ScriptControl)Sc.Language=VBScript-处理 acos-
26、For j=1 To Len(Expr)Where=InStr(Expr,acos)If Where 0 Then 名师资料总结-精品资料欢迎下载-名师精心整理-第 11 页，共 14 页 -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
27、*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-处理 asin-For j=1 To Len(Expr)Where=InStr(Expr,asin)If Where 0 Then Where=Where+3 numr=rightfind(Expr,Where)str=asin&numr On Error GoTo eh1 r=CDbl(Sc.Eval(numr)If Check2.Value=1 Then r=Atn(r/Sqr(-r*r+1
28、)*45/Atn(1)ElseIf Check2.Value=0 Then r=Atn(r/Sqr(-r*r+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-处理阶乘!-For j=1 To Len(Expr)Where=InStr(Expr,!)If Where 0 Then-有阶乘numl=leftfind(Expr,Where)str=numl&!On Error GoTo eh1 名师资料总结-精品资料欢迎下载-名师精心整理-第 12 页，共
29、14 页 -n=CDbl(Sc.Eval(numl)n=Fact(Fix(n)Expr=Replace(Expr,str,CStr(n)i=0:numl=:n=0:r=0:Where=0:str=Else Exit For End If Next j-处理排列-For j=1 To Len(Expr)Where=InStr(Expr,P)If Where 0 Then-有排列numl=leftfind(Expr,Where)numr=rightfind(Expr,Where)str=numl&P&numr On Error GoTo eh1 n=CDbl(Sc.Eval(numl)r=CDbl
30、(Sc.Eval(numr)If r n Then GoTo eh1 End If n=Fact(Fix(n)/Fact(Fix(n-r)Expr=Replace(Expr,str,CStr(n)i=0:numl=:n=0:r=0:Where=0:str=Else Exit For End If Next j-处理组合-For j=1 To Len(Expr)Where=InStr(Expr,C)If Where 0 Then-有组合numl=leftfind(Expr,Where)numr=rightfind(Expr,Where)str=numl&C&numr On Error GoTo
31、eh1 n=CDbl(Sc.Eval(numl)r=CDbl(Sc.Eval(numr)If r n Then GoTo eh1 End If n=Fact(Fix(n)/Fact(Fix(r)/Fact(Fix(n-r)名师资料总结-精品资料欢迎下载-名师精心整理-第 13 页，共 14 页 -Expr=Replace(Expr,str,CStr(n)i=0:numl=:n=0:r=0:Where=0:str=Else Exit For End If Next j-处理其他情况-Expr=Replace(Expr,Rn(,(1/)If Check2.V alue=1 Then Expr=Re
32、place(Expr,atn(,1/atn(1)*45*atn()Expr=Replace(Expr,sin(,sin(atn(1)/45*)Expr=Replace(Expr,cos(,cos(atn(1)/45*)Expr=Replace(Expr,tan(,tan(atn(1)/45*)End If Expr=Replace(Expr,e(,exp(1)()Expr=Replace(Expr,ln(,log()Expr=Replace(Expr,lg(,1/log(10)*log()On Error GoTo eh1 sum=Sc.Eval(Expr)If Sto=True Then Select Case Cha Case A A=CDbl(sum)Case B B=CDbl(sum)Case D D=CDbl(sum)Case B End Select Sto=False End If Text2.Text=sum Time=2 End Select 对应=Exit Sub eh1:Text1.Text=_:运行错误，风铃计算表达式不合语法规则!End Sub 名师资料总结-精品资料欢迎下载-名师精心整理-第 14 页，共 14 页 -