frmpurchasesalevoucher.frm

金算盘软件代码

Private Const psvoFundOut = 34                                '费用结算
Private Const psvoFundRepair = 35                             '补缴
Private Const psvoFundInterest = 36                           '利息收入

'凭证模板科目来源
Private Const psasBorrowAccount = 1                           '受托代销商品款
Private Const psasPurchaseAccount = 2                         '采购科目
Private Const psasEntrustAccount = 3                          '委托加工科目
Private Const psasLendAccount = 4                             '委托代销商品科目
Private Const psasStageAccount = 5                            '分期付款发出商品科目
Private Const psasStockAccount = 6                            '存货科目
Private Const psasDiffAccount = 7                             '差异科目
Private Const psasInComeAccount = 8                           '收入科目
Private Const psasCostAccount = 9                             '成本科目
Private Const psasUnRealSaleTaxAccount = 10                   '待实现销项税科目
Private Const psasARAccount = 11                              '应收科目
Private Const psasAPAccount = 12                              '应付科目
Private Const psasInTaxAccount = 13                           '进项税科目
Private Const psasOutTaxAccount = 14                          '销项税科目
Private Const psasUnKnownStockAccount = 15                    '待处理财产损益科目
Private Const psasHeadAccount = 16                            '单据头指定科目
Private Const psasDetailAccount = 17                          '单据体指定科目
Private Const psasGuestAccount = 18                           '采购暂估科目
Private Const psasPersonMoveInAccount = 19                    '个人帐户基金收入-转移收入
Private Const psasPersonMoveOutAccount = 20                   '个人帐户基金支出-转移支出
Private Const psasPersonInComeAccount = 21                    '个人帐户基金收入-保险费收入
Private Const psasSubventionInComeAccount = 22                '统筹基金收入-保险费收入
Private Const psasPersonPayAccount = 23                       '个人帐户基金支出-保险费支出
Private Const psasSubventionPayAccount = 24                   '统筹基金支出-保险费支出
Private Const psasPersonInterestAccount = 25                  '个人基金收入-利息收入
Private Const psasTempPayAccount = 26                         '暂付款科目
Private Const psasWaitInterestAccount = 27                    '待转利息收入科目
Private Const psasWaitInComeAccount = 28                      '待转保费收入科目

'凭证模板金额来源
Private Const psdsInAmount = 1                                '本币金额
Private Const psdsTax = 2                                     '商品的本币税金
Private Const psdsInTotalAmount = 3                           '商品的采购总金额（本币金额+本币税金）
Private Const psdsInPlanAmount = 4                            '商品的采购计划金额（数量*本币计划价）
Private Const psdsInPurchaseCost = 5                          '商品的采购成本(本币金额+采购费用-直运、受托金额)
Private Const psdsInvoicePurchaseAmount = 6                   '发票采购金额(本币金额-直运、受托金额)
Private Const psdsInvoiceAPAmount = 7                         '发票应付金额(本币金额+本币税金-受托金额[自购自销时])
Private Const psdsBorrowTax = 8                               '受托税额(受托金额*汇率*税率[自购自销时])
Private Const psdsDebitDiff = 9                               '商品的差异金额(本币成本差异)
Private Const psdsOutAmount = 10                              '商品的销售本币金额
Private Const psdsOutTotalAmount = 11                         '商品的销售本币金额
Private Const psdsOutCost = 12                                '商品的出库本币成本金额
Private Const psdsOutStockAmount = 13                         '商品的售价实际成本金额
Private Const psdsUnRealSaleTax = 14                          '待实现的销项税
Private Const psdsPurchaseAmount = 15                         '商品的采购本币金额
Private Const psdsExpenseAmount = 16                          '分摊费用本币金额
Private Const psdsDiffTax = 17                                '含税差异
Private Const psdsNoVoucherAmount = 18                        '没有制作凭证金额
Private Const psdsNoVoucherAmountTax = 19                     '没有制作凭证含税金额
Private Const psdsCreditDiff = 20                             '商品的差异金额(本币成本差异)
Private Const psdsAdjustDiff = 21                             '商品的差异金额(本币成本差异)
Private Const psdsEntrustAmount = 22                          '商品的加工本币金额
Private Const psdsPurchaseNoInvoiceAmount = 23                '只开票或只货到的金额
Private Const psdsInvoiceAmount = 24                          '本期以前采购开票金额
Private Const psdsPersonAmount = 25                           '个人帐户金额
Private Const psdsSubventionAmount = 26                       '社会统筹金额
Private Const psdsSubventionPersonAmount = 27                 '个人帐户金额+社会统筹金额
Private Const psdsPolicyAmount = 28                           '单位缴纳金额

'分录产生条件
Private Const pscfNormal = 0                                  '普通
Private Const pscfMayPlanOrRealDiff = 1                       '商品在采用售价或计划成本时
Private Const pscfMustPlan = 2                                '商品必须是计划成本
Private Const pscfMustRealDiff = 3                            '商品必须是售价
Private Const pscfMustPlanOrRealDiff = 4                      '商品必须是售价或计划成本
Private Const pscfMustHead = 5                                '业务单据头
Private Const pscfMustDetail = 6                              '业务单据体
Private Const pscfMustSame = 7                                '单货同到
Private Const pscfMustSameByPurchase = 8                      '单货同到走采购
Private Const pscfMustInvoice = 9                             '是发票
Private Const pscfNoPlanAndRealDiff = 10                      '商品必须是实际成本核算
Private Const pscfGuest = 11                                  '商品必须是实际成本核算
Private Const pscfMustIn = 12                                 '拆卸入库、组装入库
Private Const pscfMustOut = 13                                '拆卸出库、组装出库

Private Const intAccountPos = 0                     '科目标志位置
Private Const intAccountLen = 6                     '科目标志长度
Private Const intDirectionPos = 6                   '方向标志位置
Private Const intDirectionLen = 2                   '方向标志长度
Private Const intOrderPos = 8                       '分录顺序标志位置
Private Const intOrderLen = 3                       '分录顺序标志长度
Private Const intAmountPos = 11                     '金额标志位置
Private Const intAmountLen = 5                      '金额标志长度
Private Const intFlagPos = 16                       '分录条件标志位置
Private Const intFlagLen = 4                        '分录条件标志长度
Private Const intOtherAmountPos = 20                '辅助金额位置
Private Const intOtherAmountLen = 5                 '辅助金额位长度
Private Const intNegativePos = 25                   '金额为负方向取反位置
Private Const intNegativeLen = 1                    '金额为负方向取反长度
Private Const intDiffPos = 26                       '补足借贷差异金额位置
Private Const intDiffLen = 1                        '补足借贷差异金额长度
Private Const intResverPos = 27                     '自定条件位置
Private Const intResverLen = 4                      '自定条件长度

'自定义位(XXXX)
Private Const intPlanDiffNegative = 1               '计划价差异为负方向
Private Const intCombination = 2                    '合并到相同分录
Private Const intCashSettle = 4                     '现金结算
Private Const intExpenseDispart = 8                 '费用分摊

Private Const intDetailOrderPos = 0                 '凭证分录顺序标志
Private Const intDetailOrderLen = 4
Private Const intDetailModelPos = 4                 '凭证分录顺序标志
Private Const intDetailModelLen = 8
Private Const intDetailFlagPos = 12                 '凭证分录顺序标志
Private Const intDetailFlagLen = 1

Private Const mlngItemViewID = 104                  '商品列表视图号
Private Const mlngActivityViewID = 107              '业务列表视图号
Private Const mlngInsureViewID = 1159               '保险列表视图号

Private Const mintColCheck = 3

Private VoucherModel(36) As psVoucherModel          '凭证模板
Private VoucherData() As VoucherRecord              '凭证数据
Private recDetail As rdoResultset                   '业务明细
Private mVoucherPos As Integer                      '当前凭证位置
Private mDetailPos As Integer                       '当前分录位置

'向导有关的变量
Private mintStepNum As Integer                      '向导总步骤
Private mintStep As Integer                         '向导当前步骤
Private mblnEnd As Boolean                          '完成按扭是否有效
Private mblnValid() As Boolean                      '向导每步是否合法

Private WithEvents mclsReceiptGrid As Grid          'Grid对象
Attribute mclsReceiptGrid.VB_VarHelpID = -1
Private WithEvents mclsMainControl As MainControl   '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

Private mstrManner As String                        '结转内容(应收应付、现金银行、购销业务)
Private mstrEndDate As String
Private mVoucherTypeID As Long
Private mTemplateID As Long
Private mintVoucherNum  As Integer                  '凭证张数
Private mlngVoucherID As Long
Private mstrFrom As String
Private mlngFormatID As Long
Private mstrGuestID As String
Private mstrReceiptID As String
Private mstrInvoiceID As String
Private mstrPayCashID As String
Private mblnNewReceipt As Boolean
Private mblnGenCash As Boolean

'设置结转内容
' 财务业务：应收应付, 应收、应付、现金银行、财务业务
' 商品业务：采购业务、销售业务、库存业务、委托加工、购销业务、结转成本
' 保险业务：保险业务
Public Function SetManner(ByVal strManner As String, Optional strEndDate As String) As Boolean
    If Visible Then Unload Me
    Dim strCaption As String
    
    mstrManner = strManner
    mlngVoucherID = 0
    mstrEndDate = strEndDate
    
    Select Case strManner
    Case "财务业务"
        Me.HelpContextID = 60131
    Case "应收应付"
        Me.HelpContextID = 60005
    Case "应收"
        Me.HelpContextID = 60005
    Case "应付"
        Me.HelpContextID = 60005
    Case "现金银行"
        mstrManner = "收款付款"
        strManner = "收支"
        Me.HelpContextID = 60013
    Case "采购业务", "购销业务", "销售业务"
        Me.HelpContextID = 40031
    Case "库存业务"
        Me.HelpContextID = 50022
    Case "自动凭证"
        Me.HelpContextID = 60131
        mstrManner = ""
        If gVersionType = vtAccount Then
            mstrManner = "财务业务"
        End If
    Case "结转成本"
        Me.HelpContextID = 14005
    Case "保险业务"
    Case Else
        Me.HelpContextID = 60131
        mstrManner = CheckManner(strManner)
    End Select
    If Right(strManner, 2) <> "凭证" Then
        strCaption = strManner & "凭证"
    Else
        strCaption = strManner
    End If
    If mstrManner <> "" Or strManner = "自动凭证" Then 'ExclusiveIn(strCaption) Then
        Caption = strCaption
        If cboActivityType.Tag = "已设置" Then
            cboActivityType.Clear
            cboActivityType.Tag = ""
            msgReceipt.Tag = ""
            lstxtTemplate.Tag = ""
            InitActivity
            stabWizard.Tab = 0
        End If
        SetManner = True
    Else
        SetManner = False
    End If
End Function

Private Function CheckManner(ByVal strManner As String)
    Select Case strManner
    Case "加工凭证": CheckManner = "委托加工"
    Case "采购凭证": CheckManner = "采购业务"
    Case "销售凭证": CheckManner = "销售业务"
    Case "库存凭证": CheckManner = "库存业务"
    Case Else
        CheckManner = ""
    End Select
End Function

Private Sub chkInCome_Click()
     SaveSet 1, "购销凭证", "收入成本匹配", CStr(chkInCome.Value), True, "Long"
     msgReceipt.Tag = ""
End Sub

Private Sub Form_Load()
    mintVoucherNum = 0
    mlngVoucherID = 0
    mlngFormatID = 41
    mVoucherTypeID = 0
    mTemplateID = 0
    mstrGuestID = ""
    mstrReceiptID = ""
    mstrInvoiceID = ""
    cboActivityType.Tag = ""
    '主控对象
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    '向导初始化(包括每步仅需初始一次的部分)
    mintStepNum = stabWizard.Tabs - 1
    mintStep = -1
    mblnEnd = False
    ReDim mblnValid(mintStepNum)
End Sub


Private Sub Form_Resize()
    If Left < 0 Or Left > Screen.width Then Left = (Screen.width - width) / 2
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If (TypeOf Screen.ActiveControl Is ListText) Then
        If Not Screen.ActiveControl.ReferVisible Then
            If KeyCode = vbKeyReturn Then
               KeyCode = 0
               SendKeys "{Tab}", True
            End If
        End If
    Else
        If KeyCode = vbKeyReturn Then
           KeyCode = 0
           SendKeys "{Tab}", True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    On Error Resume Next
    Set recDetail = Nothing
    Set mclsReceiptGrid = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    
    If Not lstxtType.Recordset Is Nothing Then
        Utility.RemoveListRecordSet lrtVoucherType
    End If
End Sub

Private Sub Form_Activate()
    Dim vntMessage As Variant
    
    On Error Resume Next
    '进入向导第一步
    If Not mblnValid(0) Then
        stabWizard.Tab = 0
        stabWizard_Click -1
    End If
    
    '响应消息
    If lstxtTemplate.Tag = "已设置" Or stabWizard.Tab = 2 Then
        For Each vntMessage In mclsMainControl.Messages
            Select Case vntMessage
            Case Message.msgVoucherType
                RefreshVoucherType mVoucherTypeID
            Case Message.msgTemplate
                RefreshTemplate mTemplateID
            End Select
        Next
    End If
    
    gclsSys.CurrFormName = hwnd
    SetHelpID HelpContextID
    UpdateMenuStatus
End Sub

Private Sub mclsMainControl_EditColumn()
    If stabWizard.Tab = 1 Then
        cmdReceipt_Click 3