frmcaculator.frm

金算盘软件代码

         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   312
      Left            =   3120
      TabIndex        =   35
      Top             =   96
      Width           =   336
   End
End
Attribute VB_Name = "frmCalculator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'计算器
'
'作者: 欧中建
'日期:1998-7-5
'
'功能: 完成有关财务方面的计算
'
Private Finaleresult As Double
Private Result As Double
Private Result1 As String
Private Rate  As Double
Private mFinish As Boolean
Private WithEvents mclsMainControl As MainControl
Attribute mclsMainControl.VB_VarHelpID = -1
Private numGroup() As String

Public Property Get Backresult() As Double
    Backresult = Result
End Property

Public Property Get SaveValue() As Double
    SaveValue = CDbl(Result1)
End Property

'检查数据有效性
Private Function Check(ByVal strDate As String) As Boolean
    If IsNumeric(strDate) Then Check = True
End Function

'数据处理
Private Function Predure(ByVal OP As String, date1 As String, Date2 As String) As Double
    Dim intCharNum As Integer
    
    
    Select Case OP
        Case "+"
            Predure = Val(date1) + Val(Date2)
        Case "-"
            If (StrLen(date1) - StrLen(Int(date1))) - (StrLen(Date2) - StrLen(Int(Date2))) > 0 Then
                intCharNum = StrLen(date1) - StrLen(Int(date1)) - 1
            Else
                intCharNum = StrLen(Date2) - StrLen(Int(Date2)) - 1
            End If
            If intCharNum > 0 Then
                Predure = Val(Format(Val(date1) - Val(Date2), "#." & String(intCharNum, "0")))
            Else
                Predure = Val(date1) - Val(Date2)
            End If
        
        Case "×"
           Predure = Val(date1) * Val(Date2)
        Case "÷"
           If Date2 = 0 Then
               txtExplain.Locked = False
               txtExplain.Text = "除法错误,除数不能为零"
               txtExplain.Locked = True
'                ShowMsg 0, "除法错误,除数不能为零", vbOKOnly + MB_TASKMODAL, "计算器"
'                txtResult.Text = ""
               Exit Function
           End If
           Predure = Val(date1) / Val(Date2)
    End Select
End Function
'Private Sub CMDY_Click()
'    Text1.Text = ""
'    Text1.Text = " = 用于计算最后结果，例如：A+B=C，相当于功能键X，只是不退出计算器和返回结果 。 ！如果继续使用，请输入数据"
'    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(20 - Len(Text2.Text)) & Text2.Text
'        List1.Selected(List1.ListCount - 1) = True
'        Result = Val(Text2.Text)
'        Finaleresult = Result
'        Firstdateinputed = True
'        Exit Sub
'    End If
'     dd$ = Trim(List1.List(List1.ListCount - 1))
'    If dd$ = "×" Or dd$ = "÷" Then
'        List1.AddItem dd$ & Space(22 - Len(Text2.Text)) & Text2.Text, List1.ListCount - 1
'    Else
'        List1.AddItem dd$ & Space(24 - Len(Text2.Text) - Len(dd$)) & Text2.Text, List1.ListCount - 1
'    End If
'    List1.RemoveItem List1.ListCount - 1
'   'List1.AddItem Space(10) & "="
'    Predure "=", Text2.Text
'    'Text2.Text = ""
'    List1.AddItem "-------------------------"
'    Display1 (CStr(Result))
'    If Result < 1 And Result > -1 Then
'        Text2.Text = Format(CStr(Result), "0.0000000000")
'    Else
'        Text2.Text = CStr(Result)
'    End If
'    List1.Selected(List1.ListCount - 1) = True
'    qq$ = "结果" & Space(20 - Len(LTrim(List1.Text))) & LTrim(List1.Text)
'    List1.RemoveItem List1.ListCount - 1
'    List1.AddItem qq$, List1.ListCount
'    List1.Selected(List1.ListCount - 1) = True
'     If Dividerror = True Then
'         Text2.Text = "除法错误,除数不能为零"
'        Firstdateinputed = True
'        Dividerror = False
'        Exit Sub
'    End If
'    Finaleresult = Result
'    Result = 0
'    Op2 = Opp
'    Firstdateinputed = True
'End Sub

'业务功能键处理
Private Sub cmdActivity_Click(Index As Integer)
    Select Case Index
        Case 0 '设置税率
            txtExplain.Locked = False
            txtExplain.Text = " [税率设置]  用于设置税率，相当于功能键盘 S。计算器中税率默认值为17%"
            txtExplain.Locked = True
            If Not Check(txtResult.Text) Then Exit Sub
            If CDbl(txtResult.Text) < 0 Or CDbl(txtResult.Text) > 100 Then
                txtExplain.Locked = False
                txtExplain.Text = " [税率设置]  用于设置税率，相当于功能键盘 S。其值应介于0与此同时100之间"
                txtExplain.Locked = True
                Exit Sub
            End If
            Rate = Val(txtResult.Text)
            Label1.Caption = "税率：" & Left(CStr(Rate), 3) & "%"
'            Firstdateinputed = True
        Case 1 '消除税率
            txtExplain.Locked = False
            txtExplain.Text = " [消除税率] 用于消除已设置的税率。键盘上功能键为  D"
            txtExplain.Locked = True
            Rate = 0
            Label1.Caption = "税率：" & CStr(Rate) & "%"
        Case 2 '显示税率
            txtExplain.Locked = False
            txtExplain.Text = " [显示税率] 用于显示已设置的税率。 键盘上功能键为 O"
            txtExplain.Locked = True
            lstView.AddItem Space(10)
            
            lstView.AddItem "税率" & Space(10) & CStr(Rate) & "%"
            'txtResult.Text = CStr(Rate) & "%"
            lstView.Selected(lstView.ListCount - 1) = True
             'display1 (CStr(rate))
'             Firstdateinputed = True
             mFinish = True
        Case 3 '不含税价
            txtExplain.Locked = False
            txtExplain.Text = " [不含税价]  用于计算结果编辑区中数据不含税的价值，相当于功能键B"
            txtExplain.Locked = True
            If Not Check(txtResult.Text) Then Exit Sub
                
            lstView.AddItem Space(10)
            lstView.AddItem "不含税价" & Space(1) & Format(txtResult.Text, "##,##0.00")
            lstView.AddItem "税率" & Space(5) & CStr(Rate) & "%"
            lstView.AddItem "价税合计" & Space(1) & Format(CStr(CDbl(txtResult.Text) * (1 + Rate / 100)), "##,##0.00")
            lstView.AddItem "税金" & Space(5) & Format(CStr(CDbl(txtResult.Text) * Rate / 100), "##,##0.00")
            lstView.Selected(lstView.ListCount - 1) = True
'            Firstdateinputed = True
            mFinish = True
        Case 4 '税金
            txtExplain.Locked = False
            txtExplain.Text = " [税金]  用于计算税金，不含税率，价税合计各为多少。相当于功能键 J"
            txtExplain.Locked = True
            If Not Check(txtResult.Text) Then Exit Sub
            lstView.AddItem Space(10)
            lstView.AddItem "税金" & Space(5) & Format(CStr(txtResult.Text), "##,##0.00")
            lstView.AddItem "税率" & Space(5) & CStr(Rate) & "%"
            If Rate = 0 Then
               txtExplain.Locked = False
               txtExplain.Text = "你的税率是零"
               txtExplain.Locked = True
               lstView.Selected(lstView.ListCount - 1) = True
               Exit Sub
            End If
            
            lstView.AddItem "不含税价" & Space(5) & Format(CStr(Val(txtResult.Text) / (Rate / 100)), "##,##0.00")
            lstView.AddItem "价税合计" & Space(5) & Format(CStr(Val(txtResult.Text) / (Rate / 100) + Val(txtResult.Text)), "##,##0.00")
            lstView.Selected(lstView.ListCount - 1) = True
'             Firstdateinputed = True
             mFinish = True
        Case 5 '价税合计
            txtExplain.Locked = False
            txtExplain.Text = " [价税合计]  用于计算价税合计，不含税率，税金各为多少。相当于功能键 H"
            txtExplain.Locked = True
            If Not Check(txtResult.Text) Then Exit Sub
                
             lstView.AddItem Space(10)
             lstView.AddItem "价税合计" & Space(5) & CStr(txtResult.Text)
             lstView.AddItem "税率" & Space(5) & CStr(Rate) & "%"
             lstView.AddItem "不含税价" & Space(5) & Format(CStr(Val(txtResult.Text) / (1 + Rate / 100)), "##,##0.00")
             lstView.AddItem "税金" & Space(5) & Format(CStr(Val(txtResult.Text) - Val(txtResult.Text) / (1 + Rate / 100)), "##,##0.00")
             lstView.Selected(lstView.ListCount - 1) = True
'             Firstdateinputed = True
             mFinish = True
        Case 6 '返回数据
            'Dim clpRBoard As ClipBoard
            txtExplain.Locked = False
            txtExplain.Text = "[返回数据] 用于返回想得到的数据同时关闭计算器，相当于功能键 X"
            txtExplain.Locked = True
            'Set clpRBoard = New ClipBoard
            'gclssys.PrevFormName
            'mclsMainControl.MDIChildActive
            'Clipboard.Clear
           ' Clipboard.SetText txtResult.Text
           ' mEditText.Text = txtResult.Text
           Dim frmForm As MainControl
           For Each frmForm In gclsSys.MainControls
            If frmForm.Form.hwnd = Val(gclsSys.PrevFormName) Then
                If frmForm.Form.ActiveControl Is Nothing Then Exit For
                If TypeOf frmForm.Form.ActiveControl Is TextBox _
                    Or TypeOf frmForm.Form.ActiveControl Is TEdit _
                    Or TypeOf frmForm.Form.ActiveControl Is ListText _
                    Or TypeOf frmForm.Form.ActiveControl Is GATLCTRLLibCtl.CalEdit _
                    Or TypeOf frmForm.Form.ActiveControl Is GACashText Then
                    frmForm.Form.ActiveControl.Text = txtResult.Text ' Clipboard.GetData
                    'frmForm.Form.ActiveControl
                End If
            End If
          Next
            Unload Me
    End Select
End Sub

'功能键处理
Private Sub cmdFunction_Click(Index As Integer)
    Select Case Index
        Case 0 'MC
            txtExplain.Locked = False
            txtExplain.Text = " MC 用于清除存储区中数据，相当功能键CTRL+L"
            txtExplain.Locked = True
            Result1 = "error1"
            Label2.Caption = " "
        Case 1 'MR
            txtExplain.Locked = False
            txtExplain.Text = " MR 用于显示存储区数据，相当功能键CTRL+R"
            txtExplain.Locked = True
              'List1.AddItem CStr(result1)
            If IsNumeric(Result1) Then txtResult.Text = Display2(CDbl(Result1))
            'Firstdateinputed = True
        Case 2 'MS
            txtExplain.Locked = False
            txtExplain.Text = " MS 用于存储结果编辑区数据，相当于功能键CTRL+M"
            txtExplain.Locked = True
            If txtResult.Text <> "" Then
                Result1 = Val(txtResult.Text)
                Label2.Caption = "m"
                txtResult.Text = ""
           ' Firstdateinputed = True
            End If
        Case 3 'M+
            txtExplain.Locked = False
            txtExplain.Text = " M+ 用于把结果编辑区数据加在存储区中，相当于功能键CTRL+P"
            txtExplain.Locked = True
             If txtResult.Text <> "" Then
                Label2.Caption = "m"
                Result1 = CStr(Val(Result1) + Val(txtResult.Text))  'List1.List(List1.ListCount - 1)))
                txtResult.Text = ""
            End If
        Case 4 'CE
            txtExplain.Locked = False
            txtExplain.Text = " CE 用于清除过程编辑区，相当于功能键CTRL+E"
            txtExplain.Locked = True
            Result = 0
            lstView.Clear
             mFinish = False
            'Text2.SetFocus
           ' Op2 = Opp
        Case 5 'C
            txtExplain.Locked = False
            txtExplain.Text = " C 用于清除结果编辑区数据，相当于ESC功能键"
            txtExplain.Locked = True
            txtResult.Text = ""
 
        Case 6 '←
            txtExplain.Locked = False
            txtExplain.Text = " ← 用于修改结果编辑区中的数据。"
            txtExplain.Locked = True
            If Len(txtResult.Text) <> 0 Then
                txtResult.Text = Left$(txtResult.Text, Len(txtResult.Text) - 1)
                txtResult.SelStart = Len(txtResult.Text)
            End If
    End Select
End Sub

Private Sub cmdFunction_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Index = 6 And Button = 2 Then
        Modification 0
    End If
End Sub

Private Sub cmdNumber_Click(Index As Integer)
    txtExplain.Locked = False
    txtExplain.Text = "正在输入数据， 你输完了吗？"
    txtExplain.Locked = True
    Select Case Index
        Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
            txtResult.Text = txtResult.Text & Index
        Case 10
            txtResult.Text = txtResult.Text & "00"
        Case 11
            txtExplain.Locked = False
            txtExplain.Text = "± 用于设置数据的正负，相当于功能键 [ - ],计算器默认值为正数"
            txtExplain.Locked = True
            If IsNumeric(txtResult.Text) Then
                'If Val(txtResult.Text) > 0 Then
                    txtResult.Text = -Val(txtResult.Text)
               ' Else
                   ' txtResult.Text = Abs(txtResult.Text)
                'End If
                'If Abs(txtResult.Text) < 1 Then txtResult.Text = Format(txtResult.Text, "0.?")
                If Val(txtResult.Text) < 1 And Val(txtResult.Text) > 0 Then
                    txtResult.Text = "0" & txtResult.Text
                ElseIf Val(txtResult.Text) > -1 And Val(txtResult.Text) < 0 Then
                    txtResult.Text = "-0" & Abs(txtResult.Text)
                End If
            End If
        Case 12
            txtResult.Text = txtResult.Text & "."