frmaccountcard.frm

金算盘软件代码

        txtAccount(1).Text = ""
        txtAccount(0).Text = strName
    End If
    InitVar mblnIsNew
    mintDirectionOld = mintDirection
    mstrPre = CodePrefix(txtAccount(0).Text)
    'chkSuit.Enabled = Frame1.Enabled
    chkQuantity_Click
'    SendKeys "%{C}"
    mblnIsInit = False
End Sub

Private Function NatureAllowEdit(lngID As Long, ByRef PropertyAllowEdit As Boolean) As Boolean
    Dim recX As rdoResultset, strSql As String
    
    NatureAllowEdit = False
    PropertyAllowEdit = False
    mblnCurAllowEdit = True
    #If conVersionType = 16 Then
        strSql = "SELECT * FROM Setting WHERE strSection='特殊科目' AND InStr(" _
            & "'固定资产 累计折旧',strKey,1)>0 AND strSetting='" & CStr(lngID) & "'"
    #Else
        strSql = "SELECT * FROM Setting WHERE strSection='特殊科目' AND InStr(" _
            & "'待处理流动资产损益 分期收款发出商品 分期收款结算折扣 汇兑损益 " _
            & "领用出库 其它出库 其它入库 商品采购 受托代销商品款 委托代销商品 " _
            & "委托加工 自制入库 固定资产 累计折旧',strKey,1)>0 " _
            & "AND strSetting='" & CStr(lngID) & "'"
    #End If
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recX.EOF Then
        recX.Close
        Exit Function
    End If
    recX.Close
    
    #If conVersionType <> 16 Then
        strSql = "SELECT * FROM ItemNature WHERE lngSaleAccountID=" & lngID _
            & " OR lngCostAccountID=" & lngID & " OR lngStockAccountID=" & lngID _
            & " OR lngDiffAccountID=" & lngID & " OR lngStockTaxAccountID=" & lngID
        Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recX.EOF Then
            recX.Close
            Exit Function
        End If
        recX.Close
    #End If
    
'    If mtxtAccountNature <> "其它" Then
        strSql = "SELECT * FROM AccountDaily WHERE ABS(dblUnVoucherDebit)" _
            & "+ABS(dblUnPostedDebit)+ABS(dblPostedDebit)" _
            & "+ABS(dblUnVoucherCredit)+ABS(dblUnPostedCredit)" _
            & "+ABS(dblPostedCredit)+ABS(dblCurrencyUnVoucherDebit)" _
            & "+ABS(dblCurrencyUnPostedDebit)+ABS(dblCurrencyPostedDebit)" _
            & "+ABS(dblCurrencyUnVoucherCredit)+ABS(dblCurrencyUnPostedCredit)" _
            & "+ABS(dblCurrencyPostedCredit)+ABS(dblQuantityUnVoucherDebit)" _
            & "+ABS(dblQuantityUnPostedDebit)+ABS(dblQuantityPostedDebit)" _
            & "+ABS(dblQuantityUnVoucherCredit)+ABS(dblQuantityUnPostedCredit)" _
            & "+ABS(dblQuantityPostedCredit)>0 AND lngAccountID=" & lngID
        Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recX.EOF Then
'            recX.Close
            mblnCurAllowEdit = False
'            Exit Function
        End If
        recX.Close
'    End If
    
'    PropertyAllowEdit = True
    If CheckIDUsed("Customer", "lngARAccountID", lngID) Then Exit Function
    If CheckIDUsed("customer", "lngAPAccountID", lngID) Then Exit Function
    If CheckIDUsed("ActivityDetail", "lngAccountID", lngID) Then Exit Function
    If CheckIDUsed("ARAPInit", "lngAccountID", lngID) Then Exit Function
'    If CheckIDUsed("BankDetail", "lngAccountID", lngID) Then Exit Function
'    If CheckIDUsed("BankInit", "lngAccountID", lngID) Then Exit Function
    If CheckIDUsed("BudgetBalance", "lngAccountID", lngID) Then Exit Function
    If CheckIDUsed("FixedAccount", "lngAccountID", lngID) Then Exit Function
    If CheckIDUsed("FixedMethod", "lngAccountID", lngID) Then Exit Function
    If CheckIDUsed("ItemActivity", "lngAccountID", lngID) Then Exit Function
    If CheckIDUsed("Tax", "lngPurchaseTaxAccountID", lngID) Then Exit Function
    If CheckIDUsed("Tax", "lngSaleTaxAccountID", lngID) Then Exit Function
    If CheckIDUsed("TransVoucherDetail", "lngAccountID", lngID) Then Exit Function
    If CheckIDUsed("VoucherDetail", "lngAccountID", lngID) Then Exit Function
    
    PropertyAllowEdit = True
    NatureAllowEdit = True
End Function

'1--不能修改外币、数量、辅助  2--不能修改数量、辅助  9--都可以修改
'Private Function PropertyAllowEdit(lngID As Long) As Byte
'    Dim recX As rdoresultset, strSql As String
'
'    strSql = "SELECT * FROM ItemNature WHERE lngSaleAccountID=" & lngID _
'        & " OR lngCostAccountID=" & lngID
'    Set recX = gclsBase.BaseDB.openresultset(strSql, rdopenstatic)
'    If Not recX.EOF Then
'        PropertyAllowEdit = 1
'        recX.Close
'        Exit Function
'    End If
'    recX.Close
'    strSql = "SELECT * FROM Setting WHERE strSection='特殊科目' AND strKey='商品采购' " _
'        & "AND CLng(strSetting)=" & lngID
'    Set recX = gclsBase.BaseDB.openresultset(strSql, rdopenstatic)
'    If Not recX.EOF Then
'        PropertyAllowEdit = 2
'        recX.Close
'        Exit Function
'    End If
'    recX.Close
'    PropertyAllowEdit = 9
'End Function
'
Private Sub InitVar(blnNew As Boolean)
    If Not blnNew Then
        mstrCode = Trim$(txtAccount(0).Text)
        mstrName = Trim$(txtAccount(1).Text)
    Else
        mstrCode = ""
        mstrName = ""
    End If
    mstrOldCode = mstrCode
    mstrOldName = mstrName
    mblnSelCur = False
End Sub

Public Function MergeCode(ByVal lngPID As Long, ByVal lngID As Long) As Boolean
    Dim strSql As String
    
    MergeCode = False
    strSql = "DELETE FROM AccountCurrency WHERE lngAccountID=" & lngID & _
        " AND EXISTS (SELECT lngAccountID FROM AccountCurrency AC2 " & _
        " WHERE  AC2.lngCurrencyID=AccountCurrency.lngCurrencyID " & _
        " AND lngAccountID=" & lngPID & ")"
    If gclsBase.ExecSQL(strSql) = False Then Exit Function
    If Not DisplaceActivity("AccountCurrency", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not MergeAccountDaily(lngPID, lngID, "lngAccountID") Then Exit Function
    If Not DisplaceActivity("ActivityDetail", "lngAccountID", lngPID, lngID) Then Exit Function
    If gclsBase.ControlAccount Then
        If Not DisplaceActivity("ARAPInit", "lngAccountID", lngPID, lngID) Then Exit Function
    Else
        If Not DisplaceActivity("ARAPInit1", "lngAccountID", lngPID, lngID) Then Exit Function
    End If
    If Not DisplaceActivity("BankDetail", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("BankInfo", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("BankInit", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not MergeBudgetBalance(lngPID, lngID, "lngAccountID") Then Exit Function
'    If Not DisplaceActivity("BudgetBalance", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("FixedAccount", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("FixedMethod", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("ItemActivity", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("TransVoucherDetail", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("VoucherDetail", "lngAccountID", lngPID, lngID) Then Exit Function
    'SM 2000-02-16
    If Not DisplaceActivity("StdVoucherDetail", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("Check1", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("CheckDetail", "lngAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("Project", "lngAccountID", lngPID, lngID) Then Exit Function
    #If conHos = 1 Then
        If Not DisplaceActivity("AccClose", "lngAccountID", lngPID, lngID) Then Exit Function
        If Not DisplaceActivity("AccOpen", "lngAccountID", lngPID, lngID) Then Exit Function
        If Not DisplaceActivity("Receive", "lngAccountID", lngPID, lngID) Then Exit Function
        If Not DisplaceActivity("Repair", "lngAccountID", lngPID, lngID) Then Exit Function
    #End If
    
    If Not DisplaceActivity("Account", "lngDebitAccountID", 0, lngID) Then Exit Function
    If Not DisplaceActivity("Account", "lngCreditAccountID", 0, lngID) Then Exit Function
    If Not DisplaceActivity("Account", "lngProfitLossAccountID", 0, lngID) Then Exit Function
    
    If Not DisplaceActivity("Customer", "lngARAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("Customer", "lngAPAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("Customer", "lngARDiscountAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("Customer", "lngAPDiscountAccountID", lngPID, lngID) Then Exit Function
    
    If Not DisplaceActivity("ItemNature", "lngSaleAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("ItemNature", "lngCostAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("ItemNature", "lngStockAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("ItemNature", "lngDiffAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("ItemNature", "lngStockTaxAccountID", lngPID, lngID) Then Exit Function
    
    If Not DisplaceActivity("Project", "lngFundAccountID", lngPID, lngID) Then Exit Function
    
    If Not DisplaceActivity("SalaryAccount", "lngCreditAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("SalaryAccount", "lngDebitAccountID", lngPID, lngID) Then Exit Function
    
    If Not DisplaceActivity("Tax", "lngPurchaseTaxAccountID", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("Tax", "lngSaleTaxAccountID", lngPID, lngID) Then Exit Function
    
    If Not DisplaceActivity("VoucherType", "lngDebitAccountID1", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("VoucherType", "lngDebitAccountID2", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("VoucherType", "lngCreditAccountID1", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("VoucherType", "lngCreditAccountID2", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("VoucherType", "lngVoucherAccountID1", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("VoucherType", "lngVoucherAccountID2", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("VoucherType", "lngVoucherNoAccountID1", lngPID, lngID) Then Exit Function
    If Not DisplaceActivity("VoucherType", "lngVoucherNoAccountID2", lngPID, lngID) Then Exit Function
    
    If Not MergeOperatorAccount(lngPID, lngID) Then Exit Function
    If Not MergeFixedDepr2(lngPID, lngID) Then Exit Function
    MergeCode = True
End Function

'合并操作员权限表中的lngAccountID
Private Function MergeOperatorAccount(lngPID As Long, lngID As Long) As Boolean
    Dim strSql As String
    
    MergeOperatorAccount = False
    '重复时删除
    strSql = "DELETE FROM OperatorAccount WHERE lngAccountID=" & lngID & " AND EXISTS " & _
        " (SELECT Opac2.lngAccountID FROM OperatorAccount OpAc2 WHERE " & _
        " OpAc2.lngOperatorID=OperatorAccount.lngOperatorID " & _
        " AND Opac2.lngAccountID=" & lngPID & ")"
    If gclsBase.ExecSQL(strSql) = False Then Exit Function
    '替换
    If Not DisplaceActivity("OperatorAccount", "lngAccountID", lngPID, lngID) Then Exit Function
    MergeOperatorAccount = True
End Function
'合并固资科目折旧表中的lngAccountID
Private Function MergeFixedDepr2(lngPID As Long, lngID As Long) As Boolean
    Dim strSql As String
    
    MergeFixedDepr2 = False
    '重复时累加再删除
    strSql = "UPDATE FixedDepr2 Fix1 SET Fix1.dblDeprection =(SELECT Fix1.dblDeprection+" & _
        " NVL(SUM(Fix2.dblDeprection),0) FROM FixedDepr2 Fix2 " & _
        " WHERE Fix2.intYear=Fix1.intYear " & _
        " AND Fix2.bytPeriod=Fix1.bytPeriod " & _
        " AND Fix2.lngFixedCardID=Fix1.lngFixedCardID " & _
        " AND Fix2.lngAccountID=" & lngID & ")" & _
        " WHERE Fix1.lngAccountID=" & lngPID

    If gclsBase.ExecSQL(strSql) = False Then Exit Function
    strSql = "DELETE FROM FixedDepr2 WHERE lngAccountID=" & lngID & " AND EXISTS " & _
        " (SELECT Fix2.lngAccountID FROM FixedDepr2 Fix2 WHERE " & _
        " Fix2.intYear=FixedDepr2.intYear " & _
        " AND Fix2.bytPeriod=FixedDepr2.bytPeriod " & _
        " AND Fix2.lngFixedCardID=FixedDepr2.lngFixedCardID " & _
        " AND Fix2.lngAccountID=" & lngPID & ")"
    If gclsBase.ExecSQL(strSql) = False Then Exit Function
    '替换
    If Not DisplaceActivity("FixedDepr2", "lngAccountID", lngPID, lngID) Then Exit Function
    MergeFixedDepr2 = True
End Function
'合并时检查Check1表中的支票购买记录是否交叉
Private Function VerifyCheck1(lngPID As Long, lngID As Long) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    
    strSql = "SELECT lngActivityID FROM Check1 WHERE ROWNUM<=1 AND lngAccountID=" & lngPID & " AND EXISTS " & _
        " (SELECT C2.lngActivityID FROM Check1 C2 " & _
        " WHERE C2.lngAccountID=" & lngID & _
        " AND C2.lngCurrencyID=Check1.lngCurrencyID " & _
        " AND C2.lngPaymentMethodID=Check1.lngPaymentMethodID " & _
        " AND Length(C2.strCheckNo1)=Length(Check1.strCheckNo1) " & _
        " AND ((C2.strCheckNo1<=Check1.strCheckNo1 AND C2.strCheckNo2>=Check1.strCheckNo1) " & _
        " OR (C2.strCheckNo1<=Check1.strCheckNo2 AND C2.strCheckNo2>=Check1.strCheckNo2) " & _
        " OR (C2.strCheckNo1>=Check1.strCheckNo1 AND C2.strCheckNo2<=Check1.strCheckNo2)))"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        VerifyCheck1 = True
    Else
        VerifyCheck1 = False
    End If
    recTmp.Close
    Set recTmp = Nothing
End Function

Private Function SaveCard(Optional blnByAdd As Boolean = False, Optional blnIsCopy As Boolean = False) As Boolean
    Dim blnMerge As Boolean, lngAcnID As Long
    Dim intResult As Integer    '编码检查结果:1--合法 -1--上级编码不存在 -2--编码已存在 -3--编码超长
    Dim recAccount As rdoResultset, strSql As String
    Dim i As Integer, intIsInActive As Integer, intIsDetail As Integer, intCheckQuantity As Integer
    Dim intAid(6) As Integer, intAllCur As Integer, intPartCur As Integer, intSuit As Integer
    
    
    If Not mblnIsChanged Then
        SaveCard = True
        Exit Function
    End If

    On Error GoTo ErrHandle
    
    SaveCard = False
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    If Trim$(txtAccount(0).Text) = "" Then
        If Not blnByAdd Then
            ShowMsg 0, "科目编码不能为空!", vbExclamation + MB_TASKMODAL, Caption
            txtAccount(0).SetFocus
        End If
        GoTo ErrHandle
    End If
    
    If InStr(1, txtAccount(0).Text, mstrCode & "-") = 1 And Not mblnIsNew Then
        ShowMsg 0, "科目不能修改为自己的下级科目!", vbExclamation + MB_TASKMODAL, Caption
        txtAccount(0).SetFocus
        GoTo ErrHandle
    End If
    If InStr(1, mstrLastCode, txtAccount(0).Text & "-") <> 0 And Not mblnIsNew Then
        ShowMsg hwnd, "科目不能修改为自己的上级科目!", vbExclamation, Caption
        txtAccount(0).SetFocus
        GoTo ErrHandle
    End If