风铃科学计算器程序代码vb.docx
《风铃科学计算器程序代码vb.docx》由会员分享，可在线阅读，更多相关《风铃科学计算器程序代码vb.docx（22页珍藏版）》请在冰点文库上搜索。
风铃科学计算器程序代码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
'---------------
升级会员 