Option ExplicitConst CC1 = 1E+28, CC2 = 0.000000000000001, CC3 = 100000000000000# Dim Op1, Op2 ' 预先输入操作数。

Dim DecFlag% ' 小数点存在吗？Dim Klast ' 指示上一次按键事件的类型。

Dim OpFlag ' 指示未完成的操作。

Dim Kedt% ' 指示键入状态，0-未操作，1-算过，2-改过Dim MemNum ' 存储器Dim Temp2'Function sqr28(a As V ariant) As V ariantDim c As Doublec = Sqr(a)If c > CC3 Or c < CC2 Thensqr28 = cElsesqr28 = CDec(Sqr(a))sqr28 = sqr28 - (sqr28 * sqr28 - a) / sqr28 * 0.5End IfEnd FunctionFunction cur28(a As V ariant) As V ariantDim t As V ariant, c As Doublec = Abs(a) ^ (1 / 3)If c > 1000000000# Or c < 0.000000001 Thencur28 = c * Sgn(a)Elsecur28 = CDec(c) * Sgn(a)t = cur28 * cur28cur28 = cur28 - (cur28 * t - a) / t / 3End IfEnd Function' 存入存储器Private Sub BtMS_Click()If Kedt = 2 Then GetOp1MemNum = Op1LabMem.Visible = MemNum <> 0Kedt = 1End Sub' 取出存储器数据Private Sub BtMr_Click()CancelEntry_ClickOp1 = MemNumDisp = Op1Kedt = 1End Sub' 清除存储器Private Sub BtMC_Click()MemNum = CDec(0)LabMem.Visible = FalseEnd SubPrivate Sub BtOff_Click()EndEnd SubPrivate Sub Form_KeyPress(KeyAscii As Integer) Dim K As StringK = Chr(KeyAscii)'Select Case KCase Chr(24): EndCase Chr(8): CancelEntry_ClickCase Chr(27): Cancel_ClickCase "0" To "9": Number_Click KeyAscii - 48 Case ".": Decimal_ClickCase "=": Equal_ClickCase "s": BtMS_ClickCase "c": BtMC_ClickCase "r": BtMr_ClickCase "%": Func_Click 4Case "^": Func_Click 1Case "+": Operator_Click 1Case "-": Operator_Click 3Case "*": Operator_Click 2Case "/": Operator_Click 0Case "i": Func_Click 2Case "'": Func_Click 3Case "]": Func_Click 5Case "\": Func_Click 0Case ";": negcmd_ClickEnd SelectEqual.SetFocusEnd Sub' 窗体的初始化过程' 设置所有变量为其初始值。

Private Sub Form_Load()Cancel_ClickMemNum = CDec(0)LabMem.Visible = MemNum <> 0End Sub' 输入参数转长精度Sub GetOp1()Op1 = V al(Disp)If Abs(Op1) < CC1 And Abs(Op1) > CC2 Then Op1 = CDec(Disp) End Sub' C (取消)' 重新设置显示并初始化变量。

Private Sub Cancel_Click()Disp = "0."Op1 = CDec(0)Op2 = CDec(0)DecFlag = FalseKlast = "NUL"Temp2 = CDec(0)OpFlag = ""Kedt = 0End Sub' CE (取消输入) 。

Private Sub CancelEntry_Click()Disp = "0."Op1 = CDec(0)DecFlag = FalseKedt = 0End Sub' 小数点(.)' 如果上一次按键为运算符，初始化Disp 为"0."；' 否则显示时追加一个小数点。

Private Sub Decimal_Click()If Klast = "EQU" Then Cancel_ClickIf Kedt < 2 ThenDisp = "0."Kedt = 2End IfDecFlag = TrueEnd Sub' 数字键(0-9)' 向显示中的数追加新数。

Private Sub Number_Click(Index As Integer)If Klast = "EQU" Then Cancel_ClickIf Kedt < 2 ThenDisp = "."DecFlag = FalseEnd IfIf DecFlag ThenDisp = Disp + Number(Index).CaptionElseDisp = Left(Disp, InStr(Disp, Format(0, ".")) - 1) + Number(Index).Caption + Format(0, ".")End IfKedt = 2End Sub' 执行一次运算(+,-,*,/)Private Sub Operation()Dim a As Double, b As DoubleOn Error GoTo ErrH'Temp2 = Op1a = CDbl(Op1):b = CDbl(Op2)Select Case OpFlagCase "+": a = b + aCase "-": a = b - 1Case "X": a = b * aCase "/": a = b / aEnd SelectIf Abs(a) > CC1 Or Abs(a) < CC2 ThenDisp = aOp1 = aOp2 = aExit SubEnd If' 在长精度范围内Select Case OpFlagCase "+": Op1 = Op2 + Op1Case "-": Op1 = Op2 - Op1Case "X": Op1 = Op2 * Op1Case "/": Op1 = Op2 / Op1End Select'If V arType(Op1) = vbDouble And Abs(Op1) < CC1 And Abs(Op1) > CC2 Then Op1 = CDec(Op1)Disp = Op1Op2 = Op1Exit SubErrH:Cancel_ClickDisp = "ERROR!"End Sub' 运算符(=)' 如果重复按“=”，则重复最后的运算。

Private Sub Equal_Click()Select Case KlastCase "NUL"If Kedt = 2 Then GetOp1Disp = Op1Op2 = Op1Case "EQU"If OpFlag <> "" ThenOp2 = Op1Op1 = Temp2OperationEnd IfCase "OPS"If Kedt = 2 Then GetOp1OperationEnd SelectKlast = "EQU"Kedt = 1End Sub' 运算符(+, -, x, /)' 如果有一个操作数，则设置Op1。

' 如果有两个操作数，则将Op1 设置为Op1 与当前输入字符串的运算结果，并显示结果。

Private Sub Operator_Click(Index As Integer)'If Klast = "OPS" And Kedt > 0 ThenIf Kedt = 2 Then GetOp1OperationElseIf Kedt = 2 Then GetOp1Disp = Op1Op2 = Op1End IfKlast = "OPS"Kedt = 0OpFlag = Operator(Index).CaptionEnd Sub'改变数字的正负号Private Sub negcmd_Click()If Left(Disp, 1) <> "-" ThenDisp = "-" + DispElseDisp = Right(Disp, Len(Disp) - 1)End IfGetOp1End Sub' 函数计算Private Sub Func_Click(Index As Integer)On Error GoTo ErrH'If Kedt = 2 Then GetOp1Select Case IndexCase 0: ' 开根号计算If Op1 < 0 ThenMsgBox "负数开方错误", 48ElseOp1 = sqr28(Op1)End IfCase 1: ' 平方计算If Abs(Op1) > CC3 Or Abs(Op1) < 0.0000001 Then Op1 = CDbl(Op1) ^ 2ElseOp1 = Op1 * Op1End IfCase 2: ' 取整计算Op1 = Int(Op1)Case 3: ' 倒数计算If Abs(Op1) > CC3 ThenOp1 = 1 / CDbl(Op1)ElseOp1 = 1 / Op1End IfCase 4: '百分比键If Abs(Op1) < 0.0000000000001 ThenOp1 = CDbl(Op1) / 100ElseOp1 = Op1 / 100End IfCase 5: ' 开立方计算Op1 = cur28(Op1)End Select' 双精度转长精度If V arType(Op1) = vbDouble And Abs(Op1) < CC1 And Abs(Op1) > CC2 Then Op1 = CDec(Op1)Disp = Op1Kedt = 1Exit SubErrH:Cancel_ClickDisp = "ERROR!"End Sub'。