transferpubic.bas

金算盘软件代码

Attribute VB_Name = "TransferPublic"
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 转帐模块
' 1998.7.13
' 作者：唐维勇
'
' 全局枚举类型
'   1. 科目类型(enumAccountType)
'   2. 科目性质(enumAccountNature)
'   3. 科目属性(enumAccountAttribute)
'   4. 科目方向(enumAccountDirection)
'   5. 凭证来源(enumVoucherSource)
'   6. 单据类型(enumReceiptTypeX)
'   7. 业务类型(enumActivityType)
'   8  凭证结构(VoucherRecord)
'
' 公共函数、过程
'   1. AccountAttribute                                              取科目属性
'   2. SaveSet                                                       存参数表（Setting）
'   3. GetSet                                                        取参数表（Setting）
'   4. ToLong                                                        置换Long型数据的某几位
'   5. FromLong                                                      取出Long型数据的某几位
'   6. SaveVoucher                                                   根据结构保存凭证
'   7. GetMaxNo                                                      取单据最大号
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'科目类型
Public Enum enumAccountType
    atAsset = 1                                                     '资产
    atLiability = 2                                                 '负债
    atGain = 3                                                      '权益(净资产)
    atCost = 4                                                      '成本(收入)
    atLoss = 5                                                      '损益(支出)
End Enum

'科目性质
Public Enum enumAccountNature
    anCash = 1                                                      '现金
    anBank = 2                                                      '银行
    anAR = 3                                                        '应收
    anAP = 4                                                        '应付
    anInventory = 5                                                 '存货
End Enum

'科目属性
Public Enum enumAccountAttribute
    aaDetail = &H1                                                  '明细
    aaActive = &H2                                                  '在用
    aaDirection = &H4                                               '方向（1借方、0贷方）
    aaCustomer = &H8                                                '单位核算
    aaDepartment = &H10                                             '部门核算
    aaEmployee = &H20                                               '员工核算
    aaJob = &H40                                                    '工程核算
    aaClass1 = &H80                                                 '统计核算1
    aaClass2 = &H100                                                '统计核算2
    aaQuantity = &H200                                              '数量核算
    aaMultCurrency = &H400                                          '多币种核算
    aaAllCurrency = &H800                                           '全部币种核算
End Enum

'科目方向
Public Enum enumAccountDirection
    adDebit = 1                                                      '借方
    adCredit = -1                                                    '贷方
End Enum

'凭证来源
Public Enum enumVoucherSource
    vsManual = 1                                                    '手工
    vsWriteOff = 2
    vsLoss = 3
    vsTransloss = 4
    vsAR = 5
    vsAP = 6
    vsReceipt = 7
    vsPayment = 8
    vsPurchase = 9
    vsSale = 10
    vsInventory = 11
    vsCost = 12
    vsSalary = 13
    vsFixedAlter = 14
    vsFixedDeprection = 15
    vsTransfer = 16
    vsFundInterest = 17                                             '帐户计息
    vsFundMulct = 18                                                '计滞纳金
    vsFundOpen = 19                                                 '转移收入
    vsFundClose = 20                                                '转移支出
    vsFundIn = 21                                                   '基金收入
    vsFundRepair = 22                                               '基金支出
    vsFundOut = 23                                                  '基金支出
End Enum

'单据类型
Public Enum enumReceiptTypeX
    rtPurchaseOrder = 1
    rtinPurchase = 2
    rtInDirectPurchase = 3
    rtInBorrow = 4
    rtInBorrowSettlement = 5
    rtInEntrust = 6
    rtInEntrustExpense = 7
    rtInPurchaseInvoice = 8
    rtInSelf = 9
    rtInStock = 10
    rtInOther = 11
    rtSaleOrder = 12
    rtOutSale = 13
    rtOutDirectSale = 14
    rtOutLend = 15
    rtOutLendSettlement = 16
    rtOutEntrust = 17
    rtOutStage = 18
    rtOutStageSettlement = 19
    rtOutSaleInvoice = 20
    rtOutSelf = 21
    rtOutCostAdjust = 22
    rtOutStock = 23
    rtOutOther = 24
    rtBorrowPrice = 25
    rtLendMove = 26
    rtLendPrice = 27
    rtInventoryMove = 28
    rtInventoryPrice = 29
    rtAssemble = 30
    rtApart = 31
    rtInCost = 32
    rtStock = 33
    rtCreditAP = 34
    rtDebitAP = 35
    rtDebitAR = 36
    rtCreditAR = 37
    rtFinanCharge = 38
    rtPayment = 39
    rtReceipt = 40
    rtVoucher = 41
    rtInitInventory = 42
    rtInitBorrow = 43
    rtInitLend = 44
    rtInitStage = 45
    rtInitDirect = 46
    rtInitEntrust = 47
    rtFixedAdd = 48
    rtFixedSub = 49
    rtFixedAlter = 50
    rtFixedCard = 51
End Enum

'业务类型
Public Enum enumActivityType
    atInPurchase = 1
    atInDirectPurchase = 2
    atInBorrow = 3
    atInBorrowSettlement = 4
    atInEntrust = 5
    atInEntrustExpense = 6
    atInPurchaseInvoice = 7
    atInSelf = 8
    atInStock = 9
    atInOther = 10
    atOutSale = 11
    atOutDirectSale = 12
    atOutLend = 13
    atOutLendSettlement = 14
    atOutEntrust = 15
    atOutStage = 16
    atOutStageSettlement = 17
    atOutSaleInvoice = 18
    atOutSelf = 19
    atOutCostAdjust = 20
    atOutStock = 21
    atOutOther = 22
    atBorrowPrice = 23
    atInLendMove = 24
    atOutLendMove = 25
    atLendPrice = 26
    atInInventoryMove = 27
    atOutInventoryMove = 28
    atInVentoryPrice = 29
    atInAssemble = 30
    atOutAssemble = 31
    atInApart = 32
    atOutApart = 33
    atCreditAP = 34
    atDebitAP = 35
    atDebitAR = 36
    atCreditAR = 37
    atFinanCharge = 38
    atPayment = 39
    atReceipt = 40
    atInitInventory = 41
    atInitBorrow = 42
    atInitLend = 43
    atInitStage = 44
    atInitDirect = 45
    atInitEntrust = 46
    atInitPurchase = 47
    atFundIn = 48
    atFundOut = 49
    atFundRepair = 50
    atFundOpen = 51
    atFundClose = 52
End Enum

'凭证分录结构
Public Type VoucherDetailRecord
    Remark As String * 40
    AccountID As Long
    Direction As Integer
    Amount As Double
    CurrencyID As Long
    CurrencyAmount As Double
    Rate As Double
    Quantity As Double
    Price As Double
    ClassID1 As Long
    ClassID2 As Long
    JobID As Long
    CustomerID As Long
    DepartmentID As Long
    EmployeeID As Long
    Saved As Boolean               '分录是否保存
    Attribute As Long              '科目属性
    Balance As Boolean             '是自动补平分录
    DetailEntry As Long            '分录序号（4）+模板类型（7）+辅助为（1）
    Next As Integer
End Type

'凭证结构
Public Type VoucherRecord
    Used As Boolean                                                 '凭证是否有效
    Saved As Boolean                                                '凭证是否正确保存
    ErrorString As String
    VoucherID As Long
    VoucherDate As String
    TemplateID As Long
    Number As Integer
    VoucherTypeID As Long
    VoucherNO As Integer
    OperatorID As Long
    CheckerID As Long
    PostID As Long
    VoucherSourceID As Long
    SourceVoucherID As Long       '用于存放凭证格式：收、付、转
    IsPrint As Integer
    IsVoid As Integer
    IsCancel As Integer
    IsError As Integer
    Detail() As VoucherDetailRecord
End Type



'取最大编号
'最大编号自动加一后存回
'入口参数:
'         会计年度
'         会计期间
'         单据类型ID
'         单据编号字母部分
'返回值:
'         当前最大单据编号数字部分+1

Public Function GetMaxNO(ByVal intYear As Integer, ByVal bytPeriod As Byte, _
    ByVal lngTypeID As Long, ByVal strAlpha As String, Optional ByVal strDate As String = "") As Long

    Dim strNo As String
    Dim lngNewMaxNo As Long
    
    strNo = BillPublic.strGetMaxNO(ByVal intYear, bytPeriod, lngTypeID, strAlpha, strDate)
    If strNo = "" Then strNo = "0000"
    If gclsBase.NoOrder Then
        If ReceiptNOIsOk(frmMain, strDate, lngTypeID, strAlpha, C2lng(Right$(strNo, 4)), 0, False) <> 0 Then
            strNo = "0000"
        End If
    End If
    
    GetMaxNO = C2lng(Right$(strNo, 4))
End Function


'保存凭证
Public Function SaveVoucher(VoucherData() As VoucherRecord, Optional strFrom As String) As Boolean
    Dim lngCnt As Long
    Dim blnSucceed As Boolean
    
'    gclsBase.BaseWorkSpace.BeginTrans
    
    For lngCnt = 0 To UBound(VoucherData)
        If blnSucceed Then
            SaveOneVoucher VoucherData(lngCnt), strFrom
        Else
            blnSucceed = SaveOneVoucher(VoucherData(lngCnt), strFrom)
        End If
        If VoucherData(lngCnt).Saved Then
            blnModifyMaxNO gclsBase.AccountYear, gclsBase.Period, 41, CStr(VoucherData(lngCnt).VoucherTypeID), VoucherData(lngCnt).VoucherNO
        End If
    Next lngCnt
    
    If blnSucceed Then
        blnModifyMaxNO gclsBase.AccountYear, gclsBase.Period, 41, CStr(VoucherData(lngCnt - 1).VoucherTypeID), VoucherData(lngCnt - 1).VoucherNO
'        gclsBase.BaseWorkSpace.CommitTrans
    Else
'        gclsBase.BaseWorkSpace.RollBacktrans
    End If
    
    SaveVoucher = blnSucceed
End Function

Public Function SaveOneVoucher(VoucherData As VoucherRecord, Optional strFrom As String) As Boolean
    Dim strDebitAccount As String
    Dim strCreditAccount As String
    Dim lngCnt As Long, lngCntDetail As Long, lngCntDetailNo As Long, lngCntDetail0 As Long
    Dim intYear As Integer, intPeriod As Integer
    Dim lngNextDetail As Long
    Dim lngVoucherCnt As Long
    Dim lngRowno As Long
    Dim strSql As String
    Dim strVolume As String