customerinitdetail1.frm

金算盘软件代码

                End If
                Select Case mintCol
                    Case 11, 12
                        CalCurrAmount
                    Case 13, 14
                        CalRate mintCol
                End Select
                mblnIsInput(3) = False
                If .TextMatrix(mlngRow, 15) = "0" Then
                    .RowData(mlngRow) = 1
                Else
                    .RowData(mlngRow) = 2
                End If
            Case mblnIsInput(2)
                If mintCol <> 3 Then
                    If .TextMatrix(mlngRow, mintCol) = lstCustomerInitdetail(3).Text Then
                        InputFinish = True
                        lstCustomerInitdetail(3).Visible = False
                        mblnIsInput(2) = False
                        Exit Function
                    End If
                Else
                    If .TextMatrix(mlngRow, mintCol) = lstCustomerInitdetail(3).Text Then
                        InputFinish = True
                        lstCustomerInitdetail(3).Visible = False
                        mblnIsInput(2) = False
                        Exit Function
                    End If
                End If
                
                If mintCol = 4 Then
                    CalDueDate mlngRow, lstCustomerInitdetail(3).ID
                End If
                Select Case mintCol
                    Case 1
                        ChangeID 1, 16
                    Case 4
                        ChangeID 4, 17
                    Case 7 To 10
                        ChangeID mintCol, mintCol + 11
                End Select
                If lstCustomerInitdetail(3).ID = 0 And mintCol <> 3 Then
                    .TextMatrix(mlngRow, mintCol) = ""
                Else
                    If mintCol = 3 Then
                        If lstCustomerInitdetail(3).ID = 0 Then
                           .TextMatrix(mlngRow, mintCol) = Left(lstCustomerInitdetail(3).Text, 40)
                        Else
                           .TextMatrix(mlngRow, mintCol) = Left(GetNoXString(lstCustomerInitdetail(3).Text, 2), 40)
                        End If
                    Else
                        .TextMatrix(mlngRow, mintCol) = lstCustomerInitdetail(3).Text
                    End If
                End If
                lstCustomerInitdetail(3).ClearRefer
                lstCustomerInitdetail(3).Text = ""
                lstCustomerInitdetail(3).Visible = False
                mblnIsInput(2) = False
                For intCount = 0 To 30
                    mblnIsload(intCount) = False
                Next
                If .TextMatrix(mlngRow, 15) = "0" Then
                    .RowData(mlngRow) = 1
                Else
                    .RowData(mlngRow) = 2
                End If
        End Select
        InputFinish = True
    End With
End Function

'明细项输入
Private Sub FlexInput(ByVal lngRow As Long, ByVal intCol As Integer, Optional strText As String = "")
    
    If Not UserRight.IsCanDo(229, gclsBase.OperatorID) Then
       Exit Sub
    End If
    
    If lstCustomerInitdetail(0).ID = 0 Or lstCustomerInitdetail(1).ID = 0 Or _
        lstCustomerInitdetail(2).ID = 0 Then Exit Sub
    With msgCustomerInitDetail
        If .RowHeight(lngRow) = 0 Or .ColWidth(intCol) = 0 Then Exit Sub
        Select Case .LeftCol - intCol
            Case Is > 0
                .LeftCol = intCol
            Case Is < 0
                If intCol < .Cols - 1 Then
                    If Not .ColIsVisible(intCol + 1) Then
                        Do While Not .ColIsVisible(intCol + 1)
                            .LeftCol = .LeftCol + 1
                        Loop
                    End If
                End If
        End Select
        If .TextMatrix(lngRow, 22) Then Exit Sub
        Select Case intCol
            Case 0, 5, 6
                gacCustomerInitDetail.Left = .Left + .ColPos(intCol) + 45
                gacCustomerInitDetail.top = .top + .RowPos(lngRow) + 45
                gacCustomerInitDetail.width = .ColWidth(intCol) - 15
                gacCustomerInitDetail.Text = Trim(.TextMatrix(lngRow, intCol))
                gacCustomerInitDetail.Visible = True
                gacCustomerInitDetail.SetFocus
                mblnIsInput(0) = True
                mintCol = intCol
                mlngRow = lngRow
            Case 2, 11, 12, 13, 14
                calCustomerInitDetail.Left = .Left + .ColPos(intCol) + 45
                calCustomerInitDetail.top = .top + .RowPos(lngRow) + 45
                calCustomerInitDetail.width = .ColWidth(intCol) - 15
                
                calCustomerInitDetail.Visible = True
                calCustomerInitDetail.SetFocus
                If strText = "" Then
                    calCustomerInitDetail.Text = Trim(.TextMatrix(lngRow, intCol))
                Else
                    calCustomerInitDetail.Text = strText
                End If
                If intCol = 11 Then
                    If IsNumeric(.TextMatrix(lngRow, intCol)) Then
                        If CDbl(.TextMatrix(lngRow, intCol)) = 1 Then
                            Dim dblRate As Double
                            dblRate = GetRate(lngRow)
                            If dblRate <> 0 Then
                                calCustomerInitDetail.Text = Format(dblRate, mstrRateDec)
                            End If
                        End If
                    End If
                End If
                calCustomerInitDetail.SelStart = Len(calCustomerInitDetail.Text)
                mblnIsInput(3) = True
                mintCol = intCol
                mlngRow = lngRow
            Case 1, 3, 4, 7, 8, 9, 10
                If intCol >= 7 And intCol <= 10 Then
'                    If .ColData(intCol) <> 1 And .TextMatrix(lngRow, intCol) = "" Then Exit Sub
                End If
                If intCol = 3 Then
                    lstCustomerInitdetail(3).MaxLenth = 40
                Else
                    lstCustomerInitdetail(3).MaxLenth = 0
                End If
                mblnIsInput(2) = True
                mintCol = intCol
                mlngRow = lngRow
                lstCustomerInitdetail(3).Left = .Left + .ColPos(intCol) + 45
                lstCustomerInitdetail(3).top = .top + .RowPos(lngRow) + 45
                lstCustomerInitdetail(3).width = .ColWidth(intCol) - 15
                lstCustomerInitdetail(3).Text = "" '.TextMatrix(lngRow, intCol)
                lstCustomerInitdetail(3).Visible = True
                lstCustomerInitdetail(3).SetFocus
        End Select
    End With
End Sub

'数据合法性
Private Function Valid(ByVal intRow As Integer, intCol As Integer) As Boolean
    Dim intCount As Integer
    
    With msgCustomerInitDetail
        For intCount = 0 To 2
            If .TextMatrix(intRow, intCount) = "" Then
                Valid = False
                intCol = intCount
                Exit Function
            End If
        Next
        For intCount = 7 To 10
            If .ColWidth(intCount) > 0 And .ColData(intCount) = 1 Then
                If .TextMatrix(intRow, intCount) = "" Then
                    Valid = False
                    intCol = intCount
                    Exit Function
                End If
            End If
        Next
        If .TextMatrix(intRow, 13) = "" And .TextMatrix(intRow, 14) = "" Then
            Valid = False
            intCol = 13
            Exit Function
        End If
    End With
    Valid = True
End Function

'新增明细
Private Function InsertDetail(ByVal intRow As Integer) As Boolean
    Dim strSql As String
    Dim strSql1 As String
    Dim strsql2 As String
    Dim dblRate As Double
    Dim dblCurrAmount As Double
    Dim dblAmount As Double
    Dim intFlag As Integer
    Dim intDirection As Integer
    
    With msgCustomerInitDetail
        If .TextMatrix(intRow, 11) = "" Then
            dblRate = 0
        Else
            dblRate = CDbl(.TextMatrix(intRow, 11))
        End If
        If .TextMatrix(intRow, 12) = "" Then
            dblCurrAmount = 0
        Else
            dblCurrAmount = CDbl(.TextMatrix(intRow, 12))
        End If
        If .TextMatrix(intRow, 13) = "" Then
            intDirection = -1
            dblAmount = CDbl(.TextMatrix(intRow, 14))
        Else
            intDirection = 1
            dblAmount = CDbl(.TextMatrix(intRow, 13))
        End If
        strSql = "INSERT INTO ARAPInit1 (lngARAPInitID,strDate,lngVoucherTypeID,intVoucherNO,strRemark" _
            & ",lngTermID,strReceiptDate,strDueDate,dblRate,dblCurrAmount,dblAmount,intDirection" _
            & ",lngAccountID,lngCustomerID,lngCurrencyID,lngDepartmentID,lngEmployeeID" _
            & ",lngClassID1,lngClassID2)" & " VALUES (ArApInit1_Seq.NextVal,'" & .TextMatrix(intRow, 0) _
            & "'," & .TextMatrix(intRow, 16) & "," & .TextMatrix(intRow, 2) _
            & ",'" & IIf(.TextMatrix(intRow, 3) = "", " ", .TextMatrix(intRow, 3)) & "'," & .TextMatrix(intRow, 17) _
            & ",'" & .TextMatrix(intRow, 5) & "','" & .TextMatrix(intRow, 6) _
            & "'," & dblRate & "," & dblCurrAmount & "," & dblAmount & "," & intDirection _
            & "," & mudtAccount.ID & "," & mlngCustomerID & "," & mlngCurrencyID & "," _
            & .TextMatrix(intRow, 18) & "," & .TextMatrix(intRow, 19) & "," _
            & .TextMatrix(intRow, 20) & "," & .TextMatrix(intRow, 21) & ")"
        
        If intDirection = 1 Then
            strSql1 = "INSERT INTO AccountDaily (strDate,lngAccountID,lngCustomerID" _
                & ",lngCurrencyID,lngDepartmentID,lngEmployeeID,lngClassID1" _
                & ",lngClassID2,dblUnVoucherDebit,dblCurrencyUnVoucherDebit)" & " VALUES ('" _
                & .TextMatrix(intRow, 0) & "'," & mudtAccount.ID & "," & mlngCustomerID & "," _
                & mlngCurrencyID & "," & .TextMatrix(intRow, 18) & "," _
                & .TextMatrix(intRow, 19) & "," _
                & .TextMatrix(intRow, 20) & "," & .TextMatrix(intRow, 21) & "," _
                & dblAmount & "," & dblCurrAmount & ")"
        Else
            strSql1 = "INSERT INTO AccountDaily (strDate,lngAccountID,lngCustomerID" _
                & ",lngCurrencyID,lngDepartmentID,lngEmployeeID,lngClassID1" _
                & ",lngClassID2,dblUnVoucherCredit,dblCurrencyUnVoucherCredit)" & " VALUES ('" _
                & .TextMatrix(intRow, 0) & "'," & mudtAccount.ID & "," & mlngCustomerID & "," _
                & mlngCurrencyID & "," & .TextMatrix(intRow, 18) & "," _
                & .TextMatrix(intRow, 19) & "," _
                & .TextMatrix(intRow, 20) & "," & .TextMatrix(intRow, 21) & "," _
                & dblAmount & "," & dblCurrAmount & ")"
        End If
        
    On Error GoTo errhandel:
    intFlag = 1
    If strSql <> "" Then gclsBase.BaseDB.Execute strSql
    intFlag = 2
    If strSql1 <> "" Then gclsBase.BaseDB.Execute strSql1
    InsertDetail = True
    '发出单位期初消息
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustomerInit
    Exit Function
errhandel:
    Select Case Err.Number
        Case 3022, 40002
            Select Case intFlag
                Case 2
                    If intDirection = 1 Then
                        strSql1 = "UPDATE AccountDaily SET dblUnVoucherDebit=dblUnVoucherDebit+" _
                            & dblAmount & ",dblCurrencyUnVoucherDebit=dblCurrencyUnVoucherDebit+" _
                            & dblCurrAmount & " WHERE strDate='" & .TextMatrix(intRow, 0) _
                            & "' AND lngAccountID=" & mudtAccount.ID & " AND lngCurrencyID=" & mlngCurrencyID _
                            & " AND lngCustomerID=" & mlngCustomerID & " AND lngDepartmentID=" & .TextMatrix(intRow, 18) _
                            & " AND lngEmployeeID=" & .TextMatrix(intRow, 19) _
                            & " AND lngClassID1=" & .TextMatrix(intRow, 20) & " AND lngClassID2=" & .TextMatrix(intRow, 21)
                    Else
                        strSql1 = "UPDATE AccountDaily SET dblUnVoucherCredit=dblUnVoucherCredit+" _
                            & dblAmount & ",dblCurrencyUnVoucherCredit=dblCurrencyUnVoucherCredit+" _
                            & dblCurrAmount & " WHERE strDate='" & .TextMatrix(intRow, 0) _
                            & "' AND lngAccountID=" & mudtAccount.ID & " AND lngCurrencyID=" & mlngCurrencyID _
                            & " AND lngCustomerID=" & mlngCustomerID & " AND lngDepartmentID=" & .TextMatrix(intRow, 18) _
                            & " AND lngEmployeeID=" & .TextMatrix(intRow, 19) _
                            & " AND lngClassID1=" & .TextMatrix(intRow, 20) & " AND lngClassID2=" & .TextMatrix(intRow, 21)
                    End If
                    Resume
                Case 3
                    Resume Next
            End Select
        Case Else
            InsertDetail = False
            Exit Function
    End Select
End With
End Function

'更改明细
Private Function UpdateDetail(ByVal intRow As Integer) As Boolean
    Dim intCount As Integer
    Dim strSql As String
    Dim strSql1 As String
    Dim strsql2 As String
    Dim strSql3 As String
    Dim dblRate As Double
    Dim dblCurrAmount As Double
    Dim dblAmount As Double
    Dim dblOldAmount As Double
    Dim dblOldCurrAmount As Double
    Dim intFlag As Integer
    Dim recTemp As rdoResultset
    Dim lngID(4) As Long
    Dim intDirection As Integer
    
    With msgCustomerInitDetail
        If .TextMatrix(intRow, 11) = "" Then
            dblRate = 0
        Else
            dblRate = CDbl(.TextMatrix(intRow, 11))
        End If
        If .TextMatrix(intRow, 12) = "" Then
            dblCurrAmount = 0
        Else
            dblCurrAmount = CDbl(.TextMatrix(intRow, 12))
        End If
        If .TextMatrix(intRow, 13) = "" Then
            intDirection = -1
            dblAmount = CDbl(.TextMatrix(intRow, 14))
        Else
            intDirection = 1
            dblAmount = CDbl(.TextMatrix(intRow, 13))
        End If
        For intCount = 0 To 3
            lngID(intCount) = .TextMatrix(intRow, intCount + 18)
        Next
        strSql = "UPDATE ARAPInit1 SET strDate='" & .TextMatrix(intRow, 0) & "',lngVoucherTypeID=" _
            & .TextMatrix(intRow, 16) & ",intVoucherNO=" & .TextMatrix(intRow, 2) _
            & ",dblCurrAmount=" & dblCurrAmount & ",strRemark='" & .TextMatrix(intRow, 3) _
            & "',dblAmount=" & dblAmount _
            & ",strRecei