风铃科学计算器程序代码vb.docx
《风铃科学计算器程序代码vb.docx》由会员分享,可在线阅读,更多相关《风铃科学计算器程序代码vb.docx(22页珍藏版)》请在冰豆网上搜索。
![风铃科学计算器程序代码vb.docx](https://file1.bdocx.com/fileroot1/2023-4/20/f33b3307-f54f-4461-8a99-f35f6e1fb2ce/f33b3307-f54f-4461-8a99-f35f6e1fb2ce1.gif)
风铃科学计算器程序代码vb
风铃计算器程序代码
青春风铃
西南交通大学
DimsumAsDouble,Expr,A,B,D,ChaAsString
DimTimeAsInteger
Dimleftbracket,rbracketAsInteger
DimBo1,Bo2,StoAsBoolean
PublicFunctionFact(nAsLong)AsDouble
Ifn>0Then
Ifn=1Then
Fact=1
Else
Fact=n*Fact(n-1)
EndIf
ElseIfn=0Then
Fact=1
Else
Ifn=-1Then
Fact=-1
Else
Fact=n*Fact(n+1)
EndIf
EndIf
EndFunction
PrivateFunctionleftfind(ByValExprAsString,WhereAsLong)AsString
Dimi,leftbracket,rbracketAsInteger
DimnumlAsString
IfMid(Expr,Where-1,1)=")"Then'-------------左有括号
Fori=WhereTo1Step-1
IfMid(Expr,i,1)=")"Then
rbracket=rbracket+1
ElseIfMid(Expr,i,1)="("Then
lbracket=lbracket+1
EndIf
Iflbracket=rbracketAndlbracket<>0Then
numl=Mid(Expr,i,Where-i)
ExitFor
EndIf
Nexti
Else'-------------无括号
Fori=Where-1To1Step-1
numl=Mid(Expr,i,1)
Ifnuml="+"Ornuml="-"Ornuml="*"Ornuml="/"Ornuml="("Then
numl=Mid(Expr,i+1,Where-i-1)
ExitFor
EndIf
Ifi=1Then
numl=Mid(Expr,1,Where-1)
ExitFor
EndIf
Nexti
EndIf
leftfind=numl
EndFunction
PrivateFunctionrightfind(ByValExprAsString,WhereAsLong)AsString
Dimi,leftbracket,rbracketAsInteger
DimnumrAsString
IfMid(Expr,Where+1,1)="("Then'-------------右有括号
Fori=Where+1ToLen(Expr)
IfMid(Expr,i,1)=")"Then
rbracket=rbracket+1
ElseIfMid(Expr,i,1)="("Then
lbracket=lbracket+1
EndIf
Iflbracket=rbracketAndlbracket<>0Then
numr=Mid(Expr,Where+1,i-Where)
ExitFor
EndIf
Nexti
Else'-------------无括号
Fori=Where+1ToLen(Expr)
numr=Mid(Expr,i,1)
Ifnumr="+"Ornumr="-"Ornumr="*"Ornumr="/"Ornuml="("Then
numr=Mid(Expr,Where+1,i-Where-1)
ExitFor
EndIf
Ifi=Len(Expr)Then
numr=Mid(Expr,Where+1,i-Where)
ExitFor
EndIf
Nexti
EndIf
rightfind=numr
EndFunction
PrivateSubjingdian_Click(IndexAsInteger)
Frame1.BackColor=&H8080FF
Frame2.BackColor=&H80FF80
Frame3.BackColor=&HFF80FF
Text2.BackColor=&H80FF80
Fori=0To11
Label1(i).BackColor=&HFF80FF
Nexti
jingdian(0).Enabled=False
chuantong
(1).Enabled=True
pinhong
(2).Enabled=True
EndSub
PrivateSubchuantong_Click(IndexAsInteger)
Frame1.BackColor=&H8000000F
Frame2.BackColor=&H8000000F
Frame3.BackColor=&H8000000F
Text2.BackColor=&H8000000F
Fori=0To11
Label1(i).BackColor=&H8000000F
Nexti
jingdian(0).Enabled=True
chuantong
(1).Enabled=False
pinhong
(2).Enabled=True
EndSub
PrivateSubpinhong_Click(IndexAsInteger)
Frame1.BackColor=&HFF80FF
Frame2.BackColor=&HFF80FF
Frame3.BackColor=&HFF80FF
Text2.BackColor=&HFF80FF
Fori=0To11
Label1(i).BackColor=&HFF80FF
Nexti
jingdian(0).Enabled=True
chuantong
(1).Enabled=True
pinhong
(2).Enabled=False
EndSub
PrivateSubForm_Load()
A="0":
B="0":
D="0"
Sto=False:
Bo=False
Text1.Text="0"
Text2.Text="青春风铃欢迎您的使用!
"
jingdian(0).Enabled=False
EndSub
'-------------------------------------------------状态栏代码--------------------------------------------------------
PrivateSubFrame1_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
StatusBar1.Panels
(2).Text="数字键"
EndSub
PrivateSubFrame2_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
StatusBar1.Panels
(2).Text="运算符"
EndSub
PrivateSubFrame3_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
StatusBar1.Panels
(2).Text="功能区,选中Shift时执行附加功能"
EndSub
PrivateSubCommand4_MouseMove(IndexAsInteger,ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
SelectCaseIndex
Case0
StatusBar1.Panels
(2).Text="退格"
Case1
StatusBar1.Panels
(2).Text="清除"
Case2
StatusBar1.Panels
(2).Text="左括号"
Case3
StatusBar1.Panels
(2).Text="右括号"
Case4
StatusBar1.Panels
(2).Text="等于号"
EndSelect
EndSub
PrivateSubText1_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
StatusBar1.Panels
(2).Text="风铃计算表达式"
EndSub
PrivateSubText2_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
StatusBar1.Panels
(2).Text="风铃计算结果"
EndSub
PrivateSubCheck1_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
StatusBar1.Panels
(2).Text="功能转换键"
EndSub
PrivateSubCheck2_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
StatusBar1.Panels
(2).Text="选中为角度模式,否则为弧度模式"
EndSub
'---------------------数字键的输入----------------------------
PrivateSubCommand1_Click(IndexAsInteger)
IfTime<>1Then
Text1.Text=""'清空表达式
Time=1
EndIf
IfIndex<=9Then
Text1.Text=Text1.Text&Index
ElseIfIndex=10Then
Text1.Text=Text1.Text&"."
Else
Text1.Text=Text1.Text&"pi"
EndIf
EndSub
'---------------------运算符的输入----------------------------
PrivateSubCommand2_Click(IndexAsInteger)
IfTime=0Then
Text1.Text=""
ElseIfTime=2Then
Text1.Text="Ans"
EndIf
Time=1
SelectCaseIndex
Case0
Text1.Text=Text1.Text&"+"
Case1
Text1.Text=Text1.Text&"-"
Case2
Text1.Text=Text1.Text&"*"
Case3
Text1.Text=Text1.Text&"/"
EndSelect
EndSub
'---------------------函数功能的输入----------------------------
PrivateSubCommand3_Click(IndexAsInteger)
'------前处理-------
IfIndex<=2Or(Index<=11AndIndex>=8AndCheck1.Value=0)Then
IfTime=2Then
Text1.Text="Ans"'引用结果
EndIf
Else
IfTime<>1Then
Text1.Text=""'清空表达式
EndIf
EndIf
'------附加功能-------
IfCheck1.Value=0Then
SelectCaseIndex
Case8'1/x
Text1.Text=Text1.Text&"^-1"
Case9'ncr
Text1.Text=Text1.Text&"C"
Case10'npr
Text1.Text=Text1.Text&"P"
Case11'x!
Text1.Text=Text1.Text&"!
"
EndSelect
ElseIfCheck1.Value=1AndSto=FalseThen
IfTime<>1AndIndex=11Then
Text1.Text="Ans"
EndIf
SelectCaseIndex
Case8
IfTime<>1Then
Text1.Text="A="
Text2.Text=A
Else
Text1.Text=Text1.Text&"A"
EndIf
Case9
IfTime<>1Then
Text1.Text="B="
Text2.Text=B
Else
Text1.Text=Text1.Text&"B"
EndIf
Case10
IfTime<>1Then
Text1.Text="D="
Text2.Text=D
Else
Text1.Text=Text1.Text&"D"
EndIf
Case11
IfTime<>1Then
Text1.Text="Ans→"
Else
Text1.Text=Text1.Text&"→"
EndIf
Sto=True
EndSelect
Else'check1.value=1andsto=1
SelectCaseIndex
Case8
Text1.Text=Text1.Text&"A"
Case9
Text1.Text=Text1.Text&"B"
Case10
Text1.Text=Text1.Text&"D"
EndSelect
Bo=True
EndIf
IfBo=TrueThen
Bo=False
Command4_Click(4)
EndIf
'------基本功能输入-------
IfCheck1.Value=0Then
SelectCaseIndex
Case0'幂运算
Text1.Text=Text1.Text&"^"
Case1'平方
Text1.Text=Text1.Text&"^2"
Case2'立方
Text1.Text=Text1.Text&"^3"
Case3'log
Text1.Text=Text1.Text&"ln("
Case4'sin
Text1.Text=Text1.Text&"sin("
Case5'cos
Text1.Text=Text1.Text&"cos("
Case6'tan
Text1.Text=Text1.Text&"tan("
Case7'lg
Text1.Text=Text1.Text&"lg("
EndSelect
Else
SelectCaseIndex
Case0'根式运算
Text1.Text=Text1.Text&"Rn("
Case1'平方根
Text1.Text=Text1.Text&"^(1/2)"
Case2'立方根
Text1.Text=Text1.Text&"^(1/3)"
Case3'e^x
Text1.Text=Text1.Text&"e^("
Case4'asin
Text1.Text=Text1.Text&"asin("
Case5'acos
Text1.Text=Text1.Text&"acos("
Case6'tan
Text1.Text=Text1.Text&"atn("
Case7'ln
Text1.Text=Text1.Text&"10^("
EndSelect
EndIf
Time=1
EndSub
'---------------------常用按钮及等号的代码----------------------------
PrivateSubCommand4_Click(IndexAsInteger)
DimWhereAsLong
Dimnuml,numr,strAsString
Dimn,rAsDouble
Dimi,j,lbracket,rbracketAsInteger
SelectCaseIndex
Case0'<--退格
IfLen(Text1.Text)>=2Then
Text1.Text=Left(Text1.Text,Len(Text1.Text)-1)
Time=1
Else
Text1.Text="0"
Time=0
EndIf
Case1'AC清零
Text1.Text="0"
Text2.Text="0"
Time=0
sum=0
Case2'(号
IfTime<>1Then
Text1.Text=""'清空表达式
Time=1
EndIf
Text1.Text=Text1.Text&"("
Case3')号
IfTime=0Then
Text1.Text=""'清空表达式
Time=1
EndIf
Text1.Text=Text1.Text&")"
Case4'=号
Expr=Replace(Text1.Text,"pi","3.14159265358979323846264338327950288419716939937510")
Expr=Replace(Expr,"Ans",Text2.Text)
Expr=Replace(Expr,"","")
Expr=Replace(Expr,"=","")
Where=InStr(Expr,"→")
IfWhere<>0Then
Cha=Right(Expr,1)
Expr=Left(Expr,Len(Expr)-2)
EndIf
Expr=Replace(Expr,"A",A)
Expr=Replace(Expr,"B",B)
Expr=Replace(Expr,"D",D)
'-------处理括号不足问题----------
Fori=1ToLen(Expr)
IfMid(Expr,i,1)=")"Then
rbracket=rbracket+1
ElseIfMid(Expr,i,1)="("Then
lbracket=lbracket+1
EndIf
Nexti
IflbracketExpr=String(rbracket-lbracket,"(")&Expr
ElseIflbracket>rbracketThen
Expr=Expr&String(lbracket-rbracket,")")
EndIf
SetSc=CreateObject("ScriptControl")
Sc.Language="VBScript"
'---------------------处理acos----------------------------
Forj=1ToLen(Expr)
Where=InStr(Expr,"acos")
IfWhere<>0Then
Where=Where+3
numr=rightfind(Expr,Where)
str="acos"&numr
OnErrorGoToeh1
r=CDbl(Sc.Eval(numr))
IfCheck2.Value=1Then
r=(Atn(-r/Sqr(-r*r+1))+2*Atn
(1))*45/Atn
(1)
ElseIfCheck2.Value=0Then
r=Atn(-r/Sqr(-r*r+1))+2*Atn
(1)
EndIf
Expr=Replace(Expr,str,CStr(r))
i=0:
numl="":
n=0:
r=0:
Where=0:
str=""
Else
ExitFor
EndIf
Nextj
'---------------