frmaccountcard.frm

金算盘软件代码

                   vbExclamation + MB_TASKMODAL, "删除会计科目"
            End If
            GoTo ErrHandle
        ElseIf recAcn!blnIsPreDefine = 1 Then
            If blnIsShow Then
                ShowMsg 0, "“" & strCode & " " & strName & "”" & "会计科目是预置科目,不能删除!", _
                   vbExclamation + MB_TASKMODAL, "删除会计科目"
            End If
            GoTo ErrHandle
        End If
    End If
    recAcn.Close
    
    If AccountIsUsed(lngID) Then
        If blnIsShow Then
            ShowMsg lnghWnd, "“" & strCode & " " & strName & "”" & "会计科目已被使用,不允许删除!", _
                  vbExclamation + MB_TASKMODAL, "删除会计科目"
        End If
        GoTo ErrHandle
    End If
    
    If blnIsShow Then
        If ShowMsg(lnghWnd, "你确实要删除" & "“" & strCode & " " & strName & "”" & "会计科目吗?", _
                  vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, "删除会计科目") = vbNo Then
            GoTo ErrHandle
        End If
    End If
    
    If Not DeleteAccountCurrency(lngID) Then GoTo ErrHandle
    strSql = "DELETE FROM AccountDaily WHERE lngAccountID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    strSql = "DELETE FROM Account WHERE lngAccountID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    strSql = "DELETE FROM BankDetail WHERE lngAccountID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    strSql = "DELETE FROM BankInit WHERE lngAccountID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    If Not ChangeHigherCardDetail("Account", "strAccountCode", strCode) Then GoTo ErrHandle
    
    gclsBase.BaseWorkSpace.CommitTrans
    DelCard = True
    gclsSys.SendMessage Me.hwnd, Message.msgAccount
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function
'新增(LNGID=0)或编辑科目
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, Optional lnghWnd As Long = 0)
    
    If Not CheckIDUsed("Account", "lngAccountID", lngID) Then
        ShowMsg lnghWnd, "该会计科目不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改会计科目"
        Unload Me
        Exit Sub
    Else
        mblnIsChanged = False
        mlngAccountID = lngID
        mblnIsNew = False
        Caption = "修改会计科目"
        InitCard
        Show intModal
    End If
End Sub
'根据ID返回名称或根据名称返回ID
Private Function AccountX(Value, Index As Integer)
    Dim i As Integer
    
    If TypeName(Value) = "String" Then
        If Value = "" Then
            AccountX = 6
            Exit Function
        End If
        For i = 0 To cboAccount(Index).ListCount - 1
            If cboAccount(Index).list(i) = Value Then
                AccountX = cboAccount(Index).ItemData(i)
                cboAccount(Index).ListIndex = i
                Exit For
            End If
        Next i
        If Index = 1 Then
            #If conVersionType = 16 Then
                If AccountX > 4 Then AccountX = 0
            #Else
                If AccountX > 5 Then AccountX = 0
            #End If
        End If
    Else
        If Value = 6 Then
            AccountX = ""
            Exit Function
        End If
        If Value = 0 Then
            AccountX = "其它"
            Exit Function
        End If
        For i = 0 To cboAccount(Index).ListCount - 1
            If Abs(cboAccount(Index).ItemData(i)) = Abs(Value) Then
                AccountX = cboAccount(Index).list(i)
                cboAccount(Index).ListIndex = i
                Exit Function
            End If
        Next i
    End If
End Function
'指定的科目是否已使用
Public Function AccountIsUsed(ByVal lngID As Long) As Boolean
    
    AccountIsUsed = True
    If UsedInAccountDaily("lngAccountID", lngID) Then Exit Function
    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("BankInfo", "lngAccountID", lngID) Then Exit Function
    If CheckIDUsed("Project", "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
    If UsedInSetting(lngID) Then Exit Function
    If UsedInVoucherType(lngID) Then Exit Function
    AccountIsUsed = False
End Function

Private Function UsedInVoucherType(ByVal lngID As Long) As Boolean
    Dim recA As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM VoucherType WHERE LNGDEBITACCOUNTID1=" & lngID _
        & " OR LNGDEBITACCOUNTID2=" & lngID & " OR LNGCREDITACCOUNTID1=" & lngID _
        & " OR LNGCREDITACCOUNTID2=" & lngID & " OR LNGVOUCHERACCOUNTID1=" & lngID _
        & " OR LNGVOUCHERACCOUNTID2=" & lngID & " OR LNGVOUCHERNOACCOUNTID1=" & lngID _
        & " OR LNGVOUCHERNOACCOUNTID2=" & lngID
    Set recA = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    UsedInVoucherType = Not recA.EOF
    recA.Close
End Function

Private Function UsedInSetting(ByVal lngID As Long) As Boolean
    Dim recA As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM Setting WHERE strSection='特殊科目' AND strSetting='" & CStr(lngID) & "'"
    Set recA = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    UsedInSetting = Not recA.EOF
    recA.Close
End Function

Private Function AllowChangeCheck() As Boolean
    Dim recAccount As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM AccountDaily WHERE lngAccountID=" & mlngAccountID _
        & " AND lngCurrencyID<>1"
    Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    AllowChangeCheck = recAccount.EOF
    recAccount.Close
End Function

Private Sub InitCard(Optional ByVal lngTypeID As Long = -1, _
    Optional strName As String = "", Optional lngNatureID As Long = 0)
    Dim recAccount As rdoResultset ', recAcntType As rdoresultset
    Dim strSql As String, i As Integer, blnModifyProperty As Boolean
    
    mblnIsInit = True
    If Not mblnIsNew Then
        Caption = "修改会计科目"
        cmdOk(2).Visible = False
    End If
    
    cboAccount(0).Enabled = True
    cboAccount(1).Enabled = True
    mblnOAllCur = False
    mblnOPartCur = False
    mblnSelCur = False
    mlngPCodeID = 0
    mblnPIsDetail = False
    mblnPIsInActive = False
'    cboAccount(1).ItemData(cboAccount(1).NewIndex) = 6
'    cboAccount(1).AddItem "    ", 6
    
    If Not mblnIsNew Then
        strSql = "SELECT * FROM Account WHERE lngAccountID=" & mlngAccountID
        Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        txtAccount(0).Text = recAccount("strAccountCode")
        txtAccount(1).Text = recAccount("strAccountName")
        If recAccount("blnIsPreDefine") Then
            txtAccount(0).Enabled = False
            txtAccount(1).Enabled = False
        End If
        mstrLastCode = recAccount("strAccountCode")
        mstrOldFullName = Trim$(recAccount("strFullName"))
        mblnIsDetail = recAccount("blnIsDetail")
        cboAccount(0).Text = AccountX(recAccount("lngAccountTypeID"), 0)
        mlngTypeID = recAccount("lngAccountTypeID")
        mlngOldTypeID = mlngTypeID
        If recAccount("lngAccountNatureID") <> 6 Then
            cboAccount(1).Text = AccountX(recAccount("lngAccountNatureID"), 1)
        End If
        mtxtAccountNature = cboAccount(1).Text
        txtAccount(2).Text = Format$(recAccount("strQuantityUnit"), "@;;;")
        chkQuantity.Value = recAccount("blnIsQuantity")
        mintOldLevel = recAccount("intLevel")
        If recAccount!intLevel <> 1 Then
            cboAccount(0).Enabled = False
           ' cboAccount(1).Enabled = False
        End If
        optDirection(0).Value = (recAccount("intDirection") = 1)
        optDirection(1).Value = Not optDirection(0).Value
        mintDirection = recAccount("intDirection")
        'mblnIsInit = recAccount("blnIsMultCurrency")
'        optCheck(0).Enabled = AllowChangeCheck
        optCheck(2).Value = (recAccount("blnIsMultCurrency") = 1)
        optCheck(1).Value = (recAccount("blnIsAllCurrency") = 1)
        mblnOAllCur = recAccount("blnIsAllCurrency")
        mblnOPartCur = recAccount("blnIsMultCurrency")
        chkSuit.Value = recAccount("blnIsCalcExchange")
        If optCheck(0).Value = True Then
           chkSuit.Enabled = False
        Else
           chkSuit.Enabled = True
        End If
        chkAid(0).Value = recAccount("blnIsCustomer")
        chkAid(1).Value = recAccount("blnIsDepartment")
        chkAid(2).Value = recAccount("blnIsEmployee")
        chkAid(3).Value = recAccount("blnIsCash")
        chkAid(4).Value = recAccount("blnIsClass1")
        chkAid(5).Value = recAccount("blnIsClass2")
        chkAid(6).Value = recAccount("blnIsCalcInterest")
        chkStop.Value = recAccount("blnIsInActive")
        recAccount.Close
        If CodeIsDetail("Account", "strAccountCode", txtAccount(0).Text) Then
            mblnAcntNEdit = Not NatureAllowEdit(mlngAccountID, blnModifyProperty)  'Or AccountIsUsed(mlngAccountID)
            If cboAccount(0).Enabled Then cboAccount(0).Enabled = Not mblnAcntNEdit
            cboAccount(1).Enabled = Not mblnAcntNEdit
        Else
'           cboAccount(1).ListIndex = 5
            For i = 0 To 5
                chkAid(i).Enabled = False
                If i < 3 Then optCheck(i).Enabled = False
           Next i
           Frame1.Enabled = False
           chkSuit.Enabled = False
           Label1(2).Enabled = False
           cboAccount(1).Enabled = False
           chkQuantity.Enabled = False
        End If
'        bytModifyProperty = PropertyAllowEdit(mlngAccountID)
        If Not blnModifyProperty Then
            For i = 0 To 5
                If i <> 3 Then chkAid(i).Enabled = False
'                If i < 3 Then optCheck(i).Enabled = False
            Next i
            If Not optCheck(0).Value Then
                optCheck(0).Enabled = mblnCurAllowEdit
            End If
'            Label1(5).Enabled = False
'            chkQuantity.Value = 0
'            chkQuantity.Enabled = False
'        Else
'            Label1(2).Enabled = True
'            chkQuantity.Value = 0
'            chkQuantity.Enabled = True
        End If
    Else
        For i = 0 To 5
            If i <> 3 Then chkAid(i).Value = Unchecked
        Next i
        chkQuantity.Value = Unchecked
        If mlngAccountID = 0 Then
            For i = 0 To cboAccount(0).ListCount - 1
                If Abs(cboAccount(0).ItemData(i)) = lngTypeID Then Exit For
            Next i
            If i < cboAccount(0).ListCount Then
                cboAccount(0).ListIndex = i
            Else
                cboAccount(0).ListIndex = 0
            End If
            mblnAcntNEdit = False
    '        If lngTypeID Mod 3 = 1 Then
    '            optDirection(0).Value = True
    '        Else
    '            optDirection(1).Value = True
    '        End If
            If lngNatureID <> 0 Then
                cboAccount(1).ListIndex = lngNatureID - 1
            Else
                #If conVersionType = 16 Then
                    cboAccount(1).ListIndex = 4
                #Else
                    cboAccount(1).ListIndex = 5
                #End If
            End If
        Else
            cboAccount(0).ListIndex = mlngTypeID - 1
            cboAccount(1).ListIndex = IIf(mlngNatureID > 0, mlngNatureID - 1, mlngNatureID)
            If cboAccount(1).ListIndex = 2 Or cboAccount(1).ListIndex = 3 Then chkAid(0).Value = Checked
        End If
        optCheck(0).Value = True
        chkSuit.Enabled = False
        chkStop.Value = 0
        mstrOldFullName = ""