frmcaculator.frm

金算盘软件代码

'                If txtResult.SelStart = 0 And Val(txtResult.Text) < 0 Then
'                    txtResult.Text = Abs(Val(txtResult.Text))
'                Else
'                    cmdOperator_Click 0
'                End If
'            Else
'                cmdOperator_Click 4
'            End If
         
        Case vbKeyS
           If Shiftcode = 2 Then
               'cmdNumber_Click 11
           Else
               txtExplain.Locked = False
               txtExplain.Text = " S 用于设置税率，相当于键 [税率设置]。计算器中默认值为本17%"
               txtExplain.Locked = True
               cmdActivity_Click 0
           End If
        Case vbKeyD
            cmdActivity_Click 1
        Case vbKeyB
           txtExplain.Locked = False
           txtExplain.Text = " B 用于计算结果编辑区中数据不含税的价值，相当于键[不含税率]"
           txtExplain.Locked = True
           cmdActivity_Click 3
        
        Case vbKeyJ
           txtExplain.Locked = False
           txtExplain.Text = " J  用于计算当税金为结果编辑区的数时，不含税率，价税合计各为多少。相当于键[税金]"
           txtExplain.Locked = True
           cmdActivity_Click 4
        Case vbKeyH
           txtExplain.Locked = False
           txtExplain.Text = " H 用于计算当价税合计为结果编辑区中数时，不含税率，税金各为多少。相当于键 [价税合计]"
           txtExplain.Locked = True
           cmdActivity_Click 5
        Case vbKeyX
            cmdActivity_Click 6
            txtExplain.Locked = False
            txtExplain.Text = " 功能键 X 用于计算最后结果，例如：A+B=C，相当于功能键 =，只是退出计算器并返回结果 。 "
            txtExplain.Locked = True
        Case vbKeyL
           If Shiftcode = 2 Then
               txtExplain.Locked = False
               txtExplain.Text = " CTRL+L  用于清除存储区数据，相当于MC"
               txtExplain.Locked = True
               cmdFunction_Click 0
           End If
        Case vbKeyR
            If Shift = 2 Then
               txtExplain.Locked = False
               txtExplain.Text = " CTRL+R 用于显示存储区数据，相当于MR"
               txtExplain.Locked = True
               cmdFunction_Click 1
           End If
        Case vbKeyM
           If Shiftcode = 2 Then
               txtExplain.Locked = False
               txtExplain.Text = " CTRL+S 用于存储结果编辑区数据，相当于MS"
               txtExplain.Locked = True
               cmdFunction_Click 2
           End If
        Case vbKeyP
           If Shift = 2 Then
               txtExplain.Locked = False
               txtExplain.Text = " CTRL+P 用于把结果编辑区数据加入存储区的数据中，相当于M+"
               txtExplain.Locked = True
               cmdFunction_Click 3
           End If
        Case vbKeyE
           If Shiftcode = 2 Then
               txtExplain.Locked = False
               txtExplain.Text = " CTRL+E 用于清除过程编辑区，相当于CE键"
               txtExplain.Locked = True
               cmdFunction_Click 4
           End If
        Case vbKeyEscape
           txtExplain.Locked = False
           txtExplain.Text = " ESC 用于清楚结果编辑区的数据，相当于键C"
           txtExplain.Locked = True
           cmdFunction_Click 5
        Case vbKeyO
            cmdActivity_Click 2
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    Dim Shiftcode As Integer
    
    Debug.Print KeyAscii
    Select Case KeyAscii
        Case Asc("+")
            If txtResult.SelStart = 0 And Val(txtResult.Text) < 0 Then
                txtResult.Text = Abs(Val(txtResult.Text))
            Else
                cmdOperator_Click 0
            End If
        Case Asc("-")
            If txtResult.SelStart = 0 Then
                cmdNumber_Click 11
            Else
                cmdOperator_Click 2
            End If
        Case Asc("*")
            cmdOperator_Click 1
        Case Asc("/")
           cmdOperator_Click 3
        Case Asc("="), vbKeyReturn
            cmdOperator_Click 4
    End Select
        
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandle
    Me.HelpContextID = 80005
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Result1 = "error1"
    Rate = 17
    lstView.Clear
    mFinish = False
    KeyPreview = True
    txtExplain.Locked = False
    txtExplain.Text = "欢迎使用计算器！ [退出请用键盘上功能键盘 X 或 用鼠标点取 [返回数据] ]       请输入数据"
    txtExplain.Locked = True
    ReDim Preserve numGroup(0)
    gclsSys.CurrFormName = Me.hwnd
    Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         
         Unload Me
    End If
     'mEditText.Tag = gclsSys.MainControls(gclsSys.PrevFormName).Form.ActiveControl.Tag
End Sub
'Private Sub M1_Click()
'    Text1.Text = ""
'    Text1.Text = " + 用于把两数相加，例如：A+B 。！请输入加数。"
' Check Text2.Text
' If NumberLogicalflage = False Then
'    Exit Sub
' End If
' AA = Left(List1.List(List1.ListCount - 1), 2)
' If (List1.ListCount = 0) Or (AA = "结果") Or Finish = True Then
'    If AA = "结果" Or Finish = True Then
'        List1.AddItem Space(10)
'    End If
'        List1.AddItem Space(24 - Len(Text2.Text)) & Text2.Text
'        List1.AddItem "+"
'        Result = Val(Text2.Text)
'        Text2.Text = ""
'        List1.Selected(List1.ListCount - 1) = True
'        Op2 = "+"
'        Firstdateinputed = True
'       Exit Sub
'
'End If
'
'kk$ = Trim(List1.List(List1.ListCount - 1))
'If kk$ = "×" Or kk = "÷" Then
'
'    List1.AddItem kk$ & Space(22 - Len(Text2.Text)) & Text2.Text, List1.ListCount - 1
' Else
'    List1.AddItem kk$ & Space(24 - Len(Text2.Text) - Len(kk$)) & Text2.Text, List1.ListCount - 1
' End If
'
' List1.RemoveItem List1.ListCount - 1
' Predure "+", Text2.Text
' 'Text2.Text = ""
' List1.AddItem "----------------------------"
' 'display1 (CStr(result))
' List1.AddItem Space(24 - Len(Display2(CStr(Result)))) & Display2(CStr(Result))
' List1.AddItem Space(25)
' List1.AddItem Space(25)
' 'display1 (CStr(result))
' List1.AddItem Space(24 - Len(Display2(CStr(Result)))) & Display2(CStr(Result))
' List1.AddItem "+"
'
' List1.Selected(List1.ListCount - 1) = True
' Firstdateinputed = True
' End Sub
'Public Sub Display1(X As String)
'    Dim ss As Double
'    ss = Val(X)
'    If ss < 1 And ss > -1 Then
'      lstView.AddItem Space(24 - Len(CStr(Format(LTrim(X), "0.0000000000")))) & Format(LTrim(X), "0.0000000000")
'      Exit Sub
'    End If
'    lstView.AddItem Space(24 - Len(CStr(X))) & LTrim(X)
'End Sub

'数据格式化
Public Function Display2(x As Double) As String
     If x < 1 And x > -1 Then
        Display2 = Format(CStr(x), "0.##########")
        Exit Function
     End If
     Display2 = LTrim(x)
End Function

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub lstView_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'    If Button = vbRightButton Then
'        Form_MouseDown Button, Shift, X, Y
'    End If
    If Button = vbRightButton Then
        MakeRKeynmu
        PopupMenu frmMain.mnuListEdit
        SetEditEnabled
    End If
End Sub

Private Sub mclsMainControl_EditCopy()
     Clipboard.SetText Trim(Mid(lstView.list(lstView.ListIndex), 4))
End Sub

Private Sub mclsMainControl_EditPaste()
    lstView.list(lstView.ListIndex) = Clipboard.GetText
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0
        
        
        Case 3
            mclsMainControl_EditCopy
        
           
        Case 7
        
    End Select
End Sub

Private Sub txtResult_Change()
    txtResult.SetFocus
    txtResult.SelStart = Len(txtResult.Text)
    If InStr(txtResult.Text, "-") > 1 Then BKKEY txtResult.hwnd 'SendKeys "{BS}" + "{NumLock}"
    If Not IsNumeric(txtResult.Text) And txtResult.Text <> "-" Then BKKEY txtResult.hwnd 'SendKeys "{BS}" + "{NumLock}"
    If txtResult.Text Like "00*" Then BKKEY txtResult.hwnd 'SendKeys "{BS}" + "{NumLock}"
    If txtResult.Text Like "0[0,1,2,3,4,5,7,8,9]*" Then BKKEY txtResult.hwnd
    If txtResult.Text Like "*+" Then BKKEY txtResult.hwnd
    If Len(txtResult.Text) > 13 Then BKKEY txtResult.hwnd 'SendKeys "{BS}" + "{NumLock}"
End Sub
'修改
Private Function Modification(intcla As Integer, Optional Oper As String) As Boolean
    Dim i As Integer
    Dim date1 As String
    
    i = lstView.ListIndex
    Select Case intcla
        Case 0 '修改操作数
'            If i = 0 Then
'                numGroup(i) = txtResult.Text
'                refeshList (0)
'                Exit Function
'            End If
            If i > UBound(numGroup) - 1 Or i < LBound(numGroup) Then Exit Function
            If IsNumeric(numGroup(i)) And (Not IsNumeric(numGroup(i + 1)) And Not IsNull(numGroup(i + 1))) Then
                numGroup(i) = txtResult.Text
                If numGroup(i + 1) <> "=" Then refeshList (i)
            ElseIf (Not IsNumeric(numGroup(i)) And Not IsNull(numGroup(i))) And IsNumeric(numGroup(i + 1)) Then
                numGroup(i + 1) = txtResult.Text
                If i = 1 Then
                    refeshList (i - 1)
                Else
                    If numGroup(i - 4) <> "=" Then
                        refeshList (i - 4)
                    Else
                        refeshList (i - 1)
                    End If
                End If
            End If
        Case 1 '修改操作符
            If i > UBound(numGroup) Or i < LBound(numGroup) Then Exit Function
            If i = lstView.ListCount - 1 Then
                If numGroup(i) = "+" Or numGroup(i) = "-" Or numGroup(i) = "÷" Or numGroup(i) = "×" Then
                    numGroup(i) = Oper
                Else
                    Exit Function
                End If
                lstView.list(i) = Oper
                Exit Function
            End If
            If Not IsNumeric(numGroup(i)) And Not IsNull(numGroup(i)) Then
                numGroup(i) = Oper
                If IsNumeric(numGroup(i - 1)) Then
                    refeshList (i - 1)
                Else
                    refeshList (i - 4)
                End If
            End If
    End Select
End Function

'刷新列表listview
Private Sub refeshList(intp As Integer)
    Dim i As Integer
    Dim date1 As Double
    Dim Date2 As String
    i = intp
    
    Do Until numGroup(i) = "=" Or i >= lstView.ListCount - 1
        If IsNumeric(numGroup(i)) Then
            lstView.list(i) = Space(22 - Len(numGroup(i))) & numGroup(i)
            Result = CDbl(numGroup(i))
            i = i + 1
        ElseIf Not IsNumeric(numGroup(i)) And numGroup(i) <> "" Then
            If i <= lstView.ListCount - 3 Then
                If numGroup(i) = "÷" And numGroup(i + 1) = "0" Then
                        txtExplain.Locked = False
                        txtExplain.Text = "除法错误,除数不能为零"
                        txtExplain.Locked = True
                        txtResult.Text = ""
                        Exit Sub
                End If
                If numGroup(i + 1) = "" Then Exit Sub
                lstView.list(i) = numGroup(i) & Space(22 - Len(numGroup(i) & numGroup(i + 1))) & numGroup(i + 1)
                If numGroup(i + 2) <> "=" Then
                    
                    numGroup(i + 2) = CStr(Predure(numGroup(i), CStr(Result), numGroup(i + 1)))
                    lstView.list(i + 2) = Space(22 - Len(numGroup(i + 2))) & numGroup(i + 2)
                    lstView.list(i + 5) = Space(22 - Len(numGroup(i + 2))) & numGroup(i + 2)
                Else
                    
                    Date2 = CStr(Predure(numGroup(i), CStr(R