customerinitdetail.frm

金算盘软件代码

        End If
        If .TextMatrix(mlngRow, 30) = "2" Or .TextMatrix(mlngRow, 30) = "3" _
            Or .TextMatrix(mlngRow, 30) = "13" Or .TextMatrix(mlngRow, 30) = "14" _
            Or .TextMatrix(mlngRow, 30) = "8" Or .TextMatrix(mlngRow, 30) = "20" Then
            CalTax .TextMatrix(mlngRow, 39), mlngRow
            CalCurrTax
        End If
    End With
End Sub

'计算本币金额
Private Sub CalCurrAmount()
    Dim dblRate As Double
    Dim dblAmount As Double
    Dim dblCurrAmount As Double
    
    With msgCustomerInitDetail
        If .TextMatrix(mlngRow, 15) = "" Then
            dblRate = 0
        Else
            dblRate = CDbl(.TextMatrix(mlngRow, 15))
        End If
        If .TextMatrix(mlngRow, 18) = "" Then
            dblAmount = 0
        Else
            dblAmount = CDbl(.TextMatrix(mlngRow, 18))
        End If
        If dblRate = 0 Then
            dblCurrAmount = 0
        Else
            If mblnIsIndirect Then
                dblCurrAmount = dblAmount / dblRate
            Else
                dblCurrAmount = dblAmount * dblRate
            End If
        End If
        If dblCurrAmount = 0 Then
            .TextMatrix(mlngRow, 19) = ""
        Else
            .TextMatrix(mlngRow, 19) = Format(dblCurrAmount, mstrDec)
        End If
    End With
End Sub

'计算汇率
Private Sub CalRate()
    Dim dblCurrAmount As Double
    Dim dblAmount As Double
    Dim dblRate As Double
    
    With msgCustomerInitDetail
        If .TextMatrix(mlngRow, 18) = "" Then
            dblCurrAmount = 0
        Else
            dblCurrAmount = CDbl(.TextMatrix(mlngRow, 18))
        End If
        If .TextMatrix(mlngRow, 19) = "" Then
            dblAmount = 0
        Else
            dblAmount = CDbl(.TextMatrix(mlngRow, 19))
        End If
        If dblCurrAmount = 0 Then
            dblRate = 0
        Else
            If mblnIsIndirect Then
                dblRate = dblCurrAmount / dblAmount
            Else
                dblRate = dblAmount / dblCurrAmount
            End If
        End If
        If dblRate = 0 Then
            .TextMatrix(mlngRow, 15) = ""
        Else
            .TextMatrix(mlngRow, 15) = Format(dblRate, mstrRateDec)
        End If
    End With
End Sub

'计算本币税额
Private Sub CalCurrTax()
    Dim dblRate As Double
    Dim dblTax As Double
    Dim dblCurrTax As Double
    
    With msgCustomerInitDetail
        If .TextMatrix(mlngRow, 15) = "" Then
            dblRate = 0
        Else
            dblRate = CDbl(.TextMatrix(mlngRow, 15))
        End If
        If .TextMatrix(mlngRow, 21) = "" Then
            dblTax = 0
        Else
            dblTax = CDbl(.TextMatrix(mlngRow, 21))
        End If
        If dblRate = 0 Then
            dblCurrTax = 0
        Else
            If mblnIsIndirect Then
                dblCurrTax = dblTax / dblRate
            Else
                dblCurrTax = dblRate * dblTax
            End If
        End If
        If dblCurrTax = 0 Then
            .TextMatrix(mlngRow, 22) = ""
        Else
            .TextMatrix(mlngRow, 22) = Format(dblCurrTax, mstrDec)
        End If
    End With
End Sub

'计算到期日
Private Sub CalDueDate(ByVal lngRow As Long, ByVal lngID As Long)
    Dim dteReciept As Date
    Dim recTemp As rdoResultset
    
    If lngID > 0 Then
        Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT intDueDay FROM Term WHERE lngTermID=" & lngID)
        If recTemp.RowCount > 0 Then
            With msgCustomerInitDetail
                If .TextMatrix(lngRow, 5) <> "" Then
                    .TextMatrix(lngRow, 6) = Format(CDate(.TextMatrix(lngRow, 5)) + recTemp!intDueDay, "YYYY-MM-DD")
                End If
            End With
        End If
    End If
End Sub

'根据折算因子计算数量单价
Private Sub CalQuantityPrice(ByVal lngRow As Long, ByVal lngID As Long)
    Dim dblFactor As Double
    Dim dblOldFactor As Double
    Dim strQuantity As String
    
    With msgCustomerInitDetail
        dblFactor = ConvertFactor(lngID)
        If dblFactor = 0 Then
            .TextMatrix(lngRow, 46) = ""
            .TextMatrix(lngRow, 14) = ""
            .TextMatrix(lngRow, 16) = ""
        Else
            If .TextMatrix(lngRow, 46) = "" Then
                dblOldFactor = 0
            Else
                dblOldFactor = CDbl(.TextMatrix(lngRow, 46))
            End If
            .TextMatrix(lngRow, 46) = dblFactor
            If dblOldFactor > 0 Then
                If .TextMatrix(lngRow, 14) <> "" Then
                    strQuantity = BillPublic.NumberConvert(.TextMatrix(lngRow, 14), dblOldFactor)
                    .TextMatrix(lngRow, 14) = BillPublic.NumberConvert(strQuantity, dblFactor, False)
                End If
                If .TextMatrix(lngRow, 16) <> "" Then
                    .TextMatrix(lngRow, 16) = Format(CDbl(.TextMatrix(lngRow, 16)) * dblFactor / dblOldFactor, mstrCurrencyDec)
                End If
                CalSum
            End If
        End If
    End With
End Sub

'计算单价
Private Sub calPrice()
    Dim dblDiscountRate As Double
    Dim dblQuantity As Double
    Dim dblFactor As Double
    Dim dblCurrPrice As Double
    Dim dblCurrAmount As Double
    
    With msgCustomerInitDetail
        If .TextMatrix(mlngRow, 46) = "" Then
            dblFactor = 0
        Else
            dblFactor = CDbl(.TextMatrix(mlngRow, 46))
        End If
        If dblFactor > 0 Then
            If .TextMatrix(mlngRow, 14) = "" Then
                dblQuantity = 0
            Else
                dblQuantity = CDbl(NumberConvert(.TextMatrix(mlngRow, 14), dblFactor))
            End If
        End If
        If .TextMatrix(mlngRow, 17) = "" Then
            dblDiscountRate = 0
        Else
            dblDiscountRate = CDbl(.TextMatrix(mlngRow, 17))
        End If
        If dblQuantity <> 0 And dblDiscountRate > 0 Then
            If .TextMatrix(mlngRow, 18) = "" Then
                dblCurrAmount = 0
            Else
                dblCurrAmount = CDbl(.TextMatrix(mlngRow, 18))
            End If
            dblCurrPrice = Abs(dblCurrAmount * 100 * dblFactor / dblDiscountRate / dblQuantity)
            If dblCurrPrice = 0 Then
                .TextMatrix(mlngRow, 16) = ""
            Else
                .TextMatrix(mlngRow, 16) = Format(dblCurrPrice, mstrPrice)
            End If
            If dblCurrAmount > 0 Then
                If dblQuantity < 0 Then
                    .TextMatrix(mlngRow, 14) = -dblQuantity
                End If
            Else
                If dblCurrAmount < 0 Then
                    If dblQuantity > 0 Then
                        .TextMatrix(mlngRow, 14) = -dblQuantity
                    End If
                End If
            End If
        End If
    End With
End Sub

'计算税额
Private Sub CalTax(ByVal lngTaxID As Long, ByVal lngRow As Long)
    Dim dblRate As Double
    Dim dblTaxRate As Double
    Dim dblTax As Double
    Dim dblCurrTax As Double
    Dim dblAmount As Double
    
    With msgCustomerInitDetail
        dblTaxRate = GetTaxRate(lngTaxID, .TextMatrix(lngRow, 30))
        If .TextMatrix(lngRow, 18) = "" Then
            dblAmount = 0
        Else
            dblAmount = CDbl(.TextMatrix(lngRow, 18))
        End If
        dblTax = dblAmount * dblTaxRate / 100
        If dblTax = 0 Then
            .TextMatrix(lngRow, 21) = ""
        Else
            .TextMatrix(lngRow, 21) = Format(dblTax, mstrCurrencyDec)
        End If
    End With
End Sub

'设置弹出菜单
Private Sub SetMenu()
    Dim intCount As Integer
    
    With frmMain
        For intCount = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCount)
        Next
        .mnuListEditMenu(0).Caption = "插入"
        Load .mnuListEditMenu(1)
        .mnuListEditMenu(1).Caption = "删除"
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(2)
        Load .mnuListEditMenu(3)
        .mnuListEditMenu(3).Caption = "删除全部"
        If mblnIsClosed Then
            .mnuListEditMenu(0).Enabled = False
            .mnuListEditMenu(1).Enabled = False
            .mnuListEditMenu(3).Enabled = False
        Else
            .mnuListEditMenu(0).Enabled = True
            If msgCustomerInitDetail.Row > 1 Then
                .mnuListEditMenu(1).Enabled = True
            Else
                .mnuListEditMenu(1).Enabled = False
            End If
            If msgCustomerInitDetail.Rows > 2 Then
                .mnuListEditMenu(3).Enabled = True
            Else
                .mnuListEditMenu(3).Enabled = False
            End If
        End If
    End With
End Sub

'得到账套启用日期
Private Sub GetStartDate()
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "Select strStartDate From Business"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    mstrStartDate = recTemp("strStartDate")
    strSql = "SELECT * FROM AccountPeriod WHERE lngCloseID>0 AND strEndDate>='" & mstrStartDate & "'"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.RowCount > 0 Then
        mblnIsClosed = True
        Exit Sub
    Else
        mblnIsClosed = False
    End If
    Set recTemp = gclsBase.BaseDB.OpenResultset("Select strStartDate From AccountPeriod Where strStartdate<='" _
        & mstrStartDate & "' And strEndDate>='" & mstrStartDate & "'", rdOpenStatic)
    If recTemp.RowCount = 1 Then
        mstrStartDate = Format(CDate(recTemp("strStartDate")), "YYYY-MM-DD")
    End If
    recTemp.Close
    strSql = "Select Min(strStartDate) As strBeginDate From AccountPeriod"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    mstrBeginDate = recTemp("strBeginDate")
    recTemp.Close
End Sub

'得到科目性质
Private Sub GetAccountNature(ByVal lngAccountID As Long)
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "Select lngAccountNatureID,blnIsMultCurrency , blnIsAllCurrency" _
        & ",intDirection From Account Where lngAccountID=" & lngAccountID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTemp.EOF Then
        mudtAccount.Nature = recTemp("lngAccountNatureID")
        mudtAccount.IsMutCur = recTemp("blnIsMultCurrency")
        mudtAccount.IsAllCur = recTemp("blnIsAllCurrency")
        mudtAccount.Direction = recTemp("intDirection")
    End If
    recTemp.Close
End Sub

'设置参照
Private Sub SetListText(ByVal Index As Integer)
    Dim strSql As String
    
    Select Case Index
        Case 1  '单据类型
            #If conVersionType = 1 Then
                strSql = "Select lngReceiptTypeID,strReceiptTypeName From ReceiptType " _
                    & "Where lngReceiptTypeID In (2,3,5,7,34,35,39,13,14,16,19,36,37,38,40)"
            #Else
                #If conVersionType = 4 Then
                    strSql = "Select lngReceiptTypeID,strReceiptTypeName From ReceiptType " _
                        & "Where lngReceiptTypeID In (2,3,5,7,34,35,39,13,14,16,36,37,40)"
                #Else
                    #If conVersionType = 16 Then
                        strSql = "Select lngReceiptTypeID,IIf(lngReceiptTypeID=2,'采购发票',IIf(lngReceiptTypeID=13,'销售发票',strReceiptTypeName)) From ReceiptType " _
                            & "Where lngReceiptTypeID In (2,13,34,35,39,36,37,38,40)"
                    #Else
                        strSql = "Select lngReceiptTypeID,strReceiptTypeName From ReceiptType " _
                            & "Where lngReceiptTypeID In (2,3,5,34,35,39,13,14,16,19,36,37,40)"
                    #End If
                #End If
            #End If
        Case 3  '摘要
            strSql = "Select lngRemarkID,strRemarkCode,strRemarkName From Remark Order By strRemarkCode"
        Case 4  '付款条件
            strSql = "Select lngTermID,strTermCode,strTermName From Term Where blnIsInActive=0 Order By strTermCode"
        Case 7  '部门
            strSql = "Select lngDepartmentID,strDepartmentCode,strDepartmentName From Department Where blnIsInActive=0 Order By strDepartmentCode"
        Case 8  '职员