frmaccountcard.frm

金算盘软件代码

    If Trim$(txtAccount(1).Text) = "" Then
        If Not blnByAdd Then
            ShowMsg 0, "科目名称不能为空!", vbExclamation + MB_TASKMODAL, Caption
            txtAccount(1).SetFocus
        End If
        GoTo ErrHandle
    End If
    If chkQuantity.Value = 1 And Trim(txtAccount(2).Text) = "" Then
        If Not blnByAdd Then
            ShowMsg 0, "“" & Trim$(txtAccount(0).Text) & " " & Trim$(txtAccount(1).Text) & _
                "”" & "科目选择了数量核算,计量单位不能为空!", vbExclamation + MB_TASKMODAL, Caption
            txtAccount(2).SetFocus
        End If
        GoTo ErrHandle
    End If
    
    If Not mblnIsNew Then
        #If conVersionType <> 16 Then
            strSql = "SELECT strKey FROM setting WHERE strSection='" & "特殊科目" _
                & "' AND strSetting='" & mlngAccountID & "'"
            Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recAccount.EOF Then
               If recAccount.rdoColumns(0) = "商品采购" Then
                  If chkQuantity.Value = 1 Then
                     ShowMsg Me.hwnd, "该科目已在特殊科目的商品采购中使用，不能选择该科目的数量和辅助核算！", _
                               vbExclamation + MB_TASKMODAL, Me.Caption
                     chkQuantity.SetFocus
                     'SendKeys "%Q"
                     GoTo ErrHandle
                  End If
                  For i = 0 To 5
                      If chkAid(i).Value = 1 And i <> 3 Then
                         ShowMsg Me.hwnd, "该科目已在特殊科目的商品采购中使用，不能选择该科目的数量和辅助核算！", _
                               vbExclamation + MB_TASKMODAL, Me.Caption
                         chkAid(i).SetFocus
                         'SendKeys "%E"
                         GoTo ErrHandle
                      End If
                  Next
               Else
                  Select Case recAccount.rdoColumns(0)
                         Case "分期收款发出商品", "委托代销商品", "委托加工科目", "受托代销商品款"
                              If cboAccount(1).Enabled = True Then
                                 If Trim(mtxtAccountNature) <> Trim(cboAccount(1).Text) Then
                                    ShowMsg Me.hwnd, "该科目的科目性质在特殊科目中已经使用，不能修改该科目的科目性质！", _
                                      vbExclamation + MB_TASKMODAL, Me.Caption
'                                    SendKeys "%P"
                                    GoTo ErrHandle
                                 End If
                              End If
                  End Select
               End If
            End If
        #End If
    End If
        
    intResult = CodeCheck("Account", "strAccountCode", "lngAccountID", _
        mblnIsNew, txtAccount(0).Text, txtAccount(1).Text, mstrLastCode, _
        mstrOldFullName, mstrFullName, mlngPCodeID, mblnPIsDetail, _
        mblnPIsInActive, mblnIsDetail)
    If intResult = -1 Then
        If Not blnByAdd Then
            If mblnIsNew Then
                ShowMsg 0, "“" & Trim$(txtAccount(0).Text) & "”的上级科目" _
                    & "不存在,请先增加上级科目“" & CodePrefix(txtAccount(0).Text) & "”", vbExclamation + MB_TASKMODAL, Caption
            Else
                ShowMsg 0, "“" & Trim$(txtAccount(0).Text) & "”的上级科目" _
                    & "不存在,请重新修改科目“" _
                    & Trim$(txtAccount(0).Text) & "”", vbExclamation + MB_TASKMODAL, Caption
            End If
            txtAccount(0).SetFocus
        End If
        GoTo ErrHandle
    ElseIf intResult = -2 Then
        If mblnIsNew Then
            If Not blnByAdd Then
                ShowMsg 0, "科目编码“" & Trim$(txtAccount(0).Text) _
                    & "”已经存在,请重新录入科目编码", vbExclamation + MB_TASKMODAL, Caption
                txtAccount(0).SetFocus
            End If
            GoTo ErrHandle
        Else
            If Not CodeIsDetail("Account", "strAccountCode", mstrCode) Or _
                Not CodeIsDetail("Account", "strAccountCode", txtAccount(0).Text) Or _
                Not ActiveIsSame("Account", "strAccountCode", mstrCode, txtAccount(0).Text) Then
                ShowMsg hwnd, "科目“" & mstrCode & "”与科目“" _
                    & Trim$(txtAccount(0).Text) & "”不能合并,请重新修改科目编码“" _
                    & Trim$(txtAccount(0).Text) & "”", vbExclamation, Caption
                mlngPCodeID = 0
                txtAccount(0).SetFocus
                GoTo ErrHandle
            ElseIf Not frmAccountCard.PropertyIsSame(mstrCode, txtAccount(0).Text) Then
                ShowMsg hwnd, "科目“" & mstrCode & "”与科目“" _
                    & Trim$(txtAccount(0).Text) & "”辅助项目不一致,不能合并,请重新修改科目编码“" _
                    & Trim$(txtAccount(0).Text) & "”", vbExclamation, Caption
                mlngPCodeID = 0
                txtAccount(0).SetFocus
                GoTo ErrHandle
            ElseIf Not VerifyCheck1(mlngPCodeID, mlngAccountID) Then
                ShowMsg hwnd, "科目“" & mstrCode & "”与科目“" _
                    & Trim$(txtAccount(0).Text) & "”购买的票据号码重合,不能合并,请重新修改科目编码“" _
                    & Trim$(txtAccount(0).Text) & "”", vbExclamation, Caption
                mlngPCodeID = 0
                txtAccount(0).SetFocus
                GoTo ErrHandle
            Else
                If ShowMsg(0, "是否将科目“" & Trim$(txtAccount(0).Text) & "”与“" _
                    & mstrCode & "”进行合并?", vbQuestion + vbYesNo + MB_TASKMODAL, _
                     Caption) = vbNo Then
                    txtAccount(0).SetFocus
                    GoTo ErrHandle
                    'Exit Function
                Else
                    blnMerge = True
                End If
            End If
        End If
    ElseIf intResult = -3 Then
        If Not blnByAdd Then
            ShowMsg 0, "科目编码太长,请重新修改编码!", vbExclamation + MB_TASKMODAL, Caption
            txtAccount(0).SetFocus
        End If
        GoTo ErrHandle
    Else
'        If mblnIsNew Then
'           If mblnPisActive = True Then
'              ShowMsg 0, "当前科目的上级科目已被停用，不能增加当前科目！", vbExclamation _
'                        + MB_SYSTEMMODAL, Me.Caption
'              txtAccount(0).SetFocus
'              GoTo ErrHandle
'           End If
'        End If
        If mblnIsNew And mblnPIsDetail Then
            If AccountIsUsed(mlngPCodeID) Then
                If Not blnByAdd Then
                    If ShowMsg(0, "科目“" & CodePrefix(txtAccount(0).Text) & "”是一个已经发生业务的末级科目," _
                        & "是否在该科目下新增明细科目“" & Trim$(txtAccount(0).Text) & "”," _
                        & "并将发生的所有业务转到新增的明细科目?", vbQuestion + vbYesNo + MB_TASKMODAL, _
                        Caption) = vbNo Then
                        txtAccount(0).SetFocus
                        GoTo ErrHandle
                    Else
                        blnMerge = True
                    End If
                Else
                    blnMerge = True
                End If
            End If
        End If
    End If
    
'    If CheckSameName("Account", "strAccountCode", txtAccount(0).Text, _
'          "strAccountName", txtAccount(1).Text, "lngAccountID", _
'          IIf(mblnIsNew, 0, mlngAccountID)) Then
'        If Not blnByAdd Then
'            ShowMsg 0, "已有同级科目使用了" & "“" & txtAccount(1).Text & "”" & ",请重新录入科目名称!", _
'                vbExclamation + MB_TASKMODAL, Caption
'            txtAccount(1).SetFocus
'        End If
'        recAccount.Close
'        GoTo ErrHandle
'    End If
    mstrCode = Trim(txtAccount(0).Text)
    mstrName = Trim(txtAccount(1).Text)
    mblnIsInActive = (chkStop.Value = vbChecked)
    mblnIsDetail = True
    mstrStartDate = Format(gclsBase.BaseDate, "YYYY-MM-DD")
    mintLevel = stringCount(Trim(txtAccount(0).Text), "-") + 1
    mlngTypeID = Abs(AccountX(cboAccount(0).Text, 0))
    mlngNatureID = AccountX(cboAccount(1).Text, 1)
    mintDirection = IIf(optDirection(0).Value, 1, -1)
    mblnAllCur = optCheck(1).Value
    mblnPartCur = optCheck(2).Value
    mblnSuit = (chkSuit.Value = 1)
    mblnChkQuantity = (chkQuantity.Value = 1)
    mstrUnit = txtAccount(2).Text
    For i = 0 To 6
        mblnAid(i) = (chkAid(i).Value = 1)
    Next i
    If mblnIsNew Then
        If mblnPIsDetail Then
            If blnMerge Then    '上级编码是已使用的末级编码,合并业务
                If Not TransActivity(mlngPCodeID) Then GoTo ErrHandle
                lngAcnID = mlngPCodeID
                mintDirectionOld = IIf(optDirection(0).Value, 1, -1)
            Else
                If mblnPIsDetail Then
                    strSql = "UPDATE Account SET blnIsDetail=0,blnIsCustomer=0," _
                        & "blnIsDepartment=0,blnIsEmployee=0," _
                        & "blnIsClass1=0,blnIsClass2=0,blnIsQuantity=0," _
                        & "strQuantityUnit=' ',blnIsMultCurrency=0,blnIsCash=0," _
                        & "blnIsAllCurrency=0,blnIsCalcExchange=0,lngAccountNatureid=0 " _
                        & "WHERE lngAccountID=" & mlngPCodeID
                    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
                    If Not DeleteAccountCurrency(mlngPCodeID) Then GoTo ErrHandle
                End If
            End If
        End If
        If Not mblnIsInActive And mblnPIsInActive And mlngPCodeID <> 0 Then
            If ShowMsg(hwnd, "上级部门已经被停用,是否启用上级部门？", _
                vbQuestion + vbYesNo, Caption) = vbNo Then
                mblnIsInActive = True
                 strSql = "UPDATE Account SET blnIsInActive=1 WHERE " _
                    & "lngAccountID=" & mlngPCodeID
                If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
            Else
                mblnIsInActive = False
            End If
        End If
        mlngAccountID = GetNewID("Account")
        intIsInActive = IIf(mblnIsInActive, 1, 0)
        intIsDetail = IIf(mblnIsDetail, 1, 0)
        intAllCur = IIf(mblnAllCur, 1, 0)
        intPartCur = IIf(mblnPartCur, 1, 0)
        intSuit = IIf(mblnSuit, 1, 0)
        intCheckQuantity = IIf(mblnChkQuantity, 1, 0)
        For i = 0 To 6
            intAid(i) = IIf(mblnAid(i), 1, 0)
        Next i
        strSql = "INSERT INTO Account(lngAccountID,strAccountCode,strAccountName,strFullName," _
            & "blnIsInActive,intLevel,blnIsDetail,lngAccountTypeID,intDirection," _
            & "lngAccountNatureID,blnIsCustomer,blnisDepartment,blnIsEmployee," _
            & "blnIsClass1,blnIsClass2,blnIsCalcInterest,blnIsQuantity,strQuantityUnit," _
            & "blnIsMultCurrency,blnIsAllCurrency,blnIsCalcExchange,strStartDate,blnIsCash)" _
            & " VALUES(" & mlngAccountID & ",'" & mstrCode & "','" & mstrName & "','" & mstrFullName _
            & "'," & intIsInActive & "," & mintLevel & "," & intIsDetail _
            & "," & mlngTypeID & "," & mintDirection & "," & mlngNatureID _
            & "," & intAid(0) & "," & intAid(1) & "," & intAid(2) & "," _
            & intAid(4) & "," & intAid(5) & "," & intAid(6) & "," _
            & intCheckQuantity & ",'" & mstrUnit & " '," & intPartCur & "," _
            & intAllCur & "," & intSuit & ",'" & mstrStartDate & "'," _
            & intAid(3) & ")"
        gclsBase.BaseDB.Execute strSql
        If blnMerge Then mlngAccountID = mlngPCodeID
'        If Not mblnIsInActive Then
'            strSql = "SELECT * FROM Account WHERE strAccountCode='" & Trim(txtAccount(0).Text) & "'"
'            Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'            mlngAccountID = recAccount!lngAccountID
'            recAccount.Close
'        End If
        mlngNatureID = AccountX(cboAccount(1).Text, 1)   '转移业务后连续新增保持性质不变
    Else
        '进行编码合并
        If blnMerge Then
            If Not frmAccountCard.MergeCode(mlngPCodeID, mlngAccountID) Then GoTo ErrHandle
            strSql = "DELETE FROM Account WHERE lngAccountID=" & mlngAccountID
            If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
        Else
            intAllCur = IIf(optCheck(1).Value, 1, 0)
            intPartCur = IIf(optCheck(2).Value, 1, 0)
            strSql = "UPDATE Account SET strAccountCode='" & Trim$(txtAccount(0).Text) _
                & "',strAccountName='" & Trim$(txtAccount(1).Text) & "',strFullName='" _
                & mstrFullName & "',blnIsInActive=" & chkStop.Value & ",intlevel=" & mintLevel _
                & ",lngAccountTypeID=" & Abs(AccountX(cboAccount(0).Text, 0)) & ",intDirection=" _
                & IIf(optDirection(0).Value, 1, -1) & ",lngAccountNatureID=" _
                & AccountX(cboAccount(1).Text, 1) & ",blnIsCustomer=" & chkAid(0).Value _
                & ",blnisDepartment=" & chkAid(1).Value & ",blnIsEmployee=" & chkAid(2).Value _
                & ",blnIsClass1=" & chkAid(4).Value & ",blnIsClass2=" & chkAid(5).Value _
                & ",blnIsCalcInterest=" & chkAid(6).Value & ",blnIsQuantity=" & chkQuantity.Value & ",strQuantityUnit='" _
                & txtAccount(2).Text & " ',blnIsMultCurrency=" & intPartCur & ",blnIsAllCurrency=" _
                & intAllCur & ",blnIsCalcExchange=" & chkSuit.Value & ",blnIsCash=" & chkAid(3).Value _
                & " WHERE lngAccountID=" & mlngAccountID
            gclsBase.BaseDB.Execute strSql
'            If Not optCheck(2).Value Then
'                If Not DeleteAccountCurrency(mlngAccountID) Then GoTo ErrHandle
'            End If
            If Not ChangeLowerCardCodeAndFullName("Account", "strAccountCode", _
                "strFullName", "lngAccountID", mstrLastCode, mstrOldFullName, mstrCode, _
                mstrFullName, mintOldLevel, mintLevel) Then GoTo ErrHandle
            If mlngTypeID <> mlngOldTypeID Then
                If Not ChangeLowerAccountType Then GoTo ErrHandle
            End If
            If mblnIsInActive Then      '本级停用时改变下级的停用属性
                If Not ChangeLowerActive("Account", "strAccountCode", mstrCode) _
                    Then GoTo ErrHandle
            End If
            If mblnPIsDetail Then
                strSql = "UPDATE Account SET blnIsDetail=0,blnIsCustomer=0," _
                    & "blnIsDepartment=0,blnIsEmployee=0," _
                    & "blnIsClass1=0,blnIsClass2=0,blnIsQuantity=0," _
                    & "strQuantityUnit=' ',blnIsMultCurrency=0,blnIsCash=0," _
                    & "blnIsAllCurrency=0,blnIsCalcExchange=0,lngAccountNatureid=0 " _
                    & "WHERE lngAccountID=" & mlngPCodeID
                If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
                If Not DeleteAccountCurrency(mlngPCodeID) Then GoTo ErrHandle
            End If
        End If
        If mlngPCodeID <> 0 And mlngAccountID <> mlngPCodeID And Not blnMerge Then
            If Not HandleBalanceAndDaily Then GoTo ErrHandle
        End If
        If Not ChangeHigherCardDetail("Account", "strAccountCode", mstrLastCode) Then GoTo ErrHandle
    End If
'    If Not UpdateVoucherAccount Then GoTo ErrHandle '调整凭证的借贷方编码
    If Not mblnIsInActive And mblnPIsInActive Then  '本级是活动时改变上级的停用属性
        If Not ChangeHigherActive("Account", "strAccountCode", mstrCode) _
            Then GoTo ErrHandle
    End If
'    '重新选择了核算币种后更新科目币种表
'    If optCheck(2).Value And mblnSelCur Then
''        Dim i As Integer
'        strSql = "DELETE FROM AccountCurrency WHERE lngAccountID=" & mlngAccountID
'        If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
'