frmloss.frm

金算盘软件代码

        cmdStep(1).Enabled = True
        cmdStep(2).Enabled = True
    End Select
    
    '是否每步都合法
    For lngCnt = 0 To mintStepNum
        If Not mblnValid(lngCnt) Then
            Exit For
        End If
    Next lngCnt
    cmdStep(3).Enabled = (lngCnt > mintStepNum)
    
    '若是最后一步，把完成按扭变为有效
    If Not cmdStep(3).Enabled Then
        If stabWizard.Tab = mintStepNum Then
            cmdStep(3).Enabled = True
        End If
    End If

    If stabWizard.Tab = stabWizard.Tabs - 1 Then
        On Error Resume Next
        cmdStep(3).SetFocus
    Else
        On Error Resume Next
        cmdStep(2).SetFocus
    End If
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  向导步骤初始化
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'第一步：结转损益科目初始
Private Function InitAccount()
    Dim strSql As String, recLossAccount As rdoResultset
    Dim mstrAccountSystem As String
    Dim lngID As Long, lngCnt As Long
    Dim strCode As String
    
    If fraWizard(0).Tag <> "已设置" Then
        mstrAccountSystem = gclsBase.AccountSys
        fraWizard(0).Tag = "已设置"
        
        cboDirection.Clear
        cboDirection.AddItem "自动转出"
        cboDirection.AddItem "借方转出"
        cboDirection.AddItem "贷方转出"
        
        lngID = CLng(GetSet(1, "损益结转", "本年利润", 0))
        If lngID > 0 Then
            strSql = "SELECT strAccountCode FROM Account WHERE lngAccountID=" & lngID
            Set recLossAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recLossAccount.EOF Then
                strCode = recLossAccount!strAccountCode
            End If
        End If

        strSql = "SELECT Allaccount.lngAccountID AS ID, DECODE(Allaccount.blnIsProfitLoss,1,DECODE(InStr(Lossaccount.strAccountCode,'" & strCode & "'),1,'√',''),'') As 选择, " _
                & "Allaccount.strAccountCode || ' ' || Allaccount.strAccountName AS 转出科目, " _
                & "DECODE(Allaccount.blnIsProfitLoss,1,DECODE(InStr(Lossaccount.strAccountCode,'" & strCode & "'),1,Lossaccount.strAccountCode || ' ' || Lossaccount.strAccountName,''),'') AS 转入科目, " _
                & "DECODE(Allaccount.blnIsProfitLoss,1,Lossaccount.lngAccountID,0)  AS LossID," _
                & "DECODE(Allaccount.intLossDirection,1,'借方转出',2,'贷方转出','自动转出') As 转出方向 "
        If mstrAccountSystem = "2" Or mstrAccountSystem = "3" Or mstrAccountSystem = "4" Or mstrAccountSystem = "5" Then
            Caption = "收支结转"
            If mstrAccountSystem = "5" Then
                If gclsBase.Trade = "失业保险基金" Then
                    lblProfit.Caption = "失业保险基金"
                Else
                    lblProfit.Caption = "统筹基金科目"
                End If
            Else
                lblProfit.Caption = "收支结余科目"
            End If
            strSql = strSql & "FROM Account AllAccount LEFT JOIN Account LossAccount " _
                    & "ON AllAccount.lngProfitLossAccountID=LossAccount.lngAccountID " _
                    & "WHERE (AllAccount.lngAccountTypeID=" & atLoss & " OR AllAccount.lngAccountTypeID=" _
                    & atCost & ") AND Allaccount.blnIsDetail AND NOT AllAccount.blnIsInActive"
        Else
            Caption = "损益结转"
            lblProfit.Caption = "本年利润科目"
            'strSql = strSql & "FROM Account AllAccount LEFT JOIN Account LossAccount " _
                    & "ON AllAccount.lngProfitLossAccountID=LossAccount.lngAccountID " _
                    & "WHERE AllAccount.lngAccountTypeID=" & atLoss & " AND Allaccount.blnIsDetail " _
                    & "AND NOT AllAccount.blnIsInActive"
            strSql = strSql & "FROM Account AllAccount,Account LossAccount " _
                    & " WHERE AllAccount.lngProfitLossAccountID=LossAccount.lngAccountID(+) " _
                    & " AND AllAccount.lngAccountTypeID=" & atLoss & " AND Allaccount.blnIsDetail=1 " _
                    & " AND AllAccount.blnIsInActive=0"
        End If
        strSql = strSql & " ORDER BY Allaccount.strAccountCode"
        
        'Set recLossAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set recLossAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        'Set datLoss.Recordset = recLossAccount
        Set datLoss.Resultset = recLossAccount
    
        Set mclsLossGrid = New Grid
        Set mclsLossGrid.Grid = msgLossAccount
'        Set mclsLossGrid.Form = Me
'        mclsLossGrid.HwndCancel = cmdStep(0).hwnd
        
        mclsLossGrid.ColOfs = 2
        mclsLossGrid.SetupStyle
        msgLossAccount.ColWidth(0) = 0
        msgLossAccount.ColWidth(1) = 450
        msgLossAccount.ColWidth(2) = 2300
        msgLossAccount.ColWidth(3) = 1800
        msgLossAccount.ColWidth(4) = 0
        msgLossAccount.ColWidth(5) = 900
        mclsLossGrid.SetEditText "转入科目", "", "", "", lstxtAccount
        mclsLossGrid.SetEditText "转出方向", "", "", "", cboDirection
        
        '转入科目参照
        RefreshAccount
        '本年利润科目参照
        RefreshProfit lngID
        If lngID = 0 Then
            For lngCnt = 1 To msgLossAccount.Rows - 1
                If C2lng(msgLossAccount.TextMatrix(lngCnt, 4)) > 0 Then
                    If InStr(msgLossAccount.TextMatrix(lngCnt, 3), "-") > 0 Then
                        ltxtProfit.Text = Left(msgLossAccount.TextMatrix(lngCnt, 3), InStr(msgLossAccount.TextMatrix(lngCnt, 3), "-") - 1)
                    Else
                        ltxtProfit.Text = msgLossAccount.TextMatrix(lngCnt, 3)
                    End If
                End If
                If Trim(ltxtProfit.Text) <> "" Then Exit For
            Next lngCnt
        End If
    End If
    
    If stabWizard.TabVisible(1) Then
        InitAccount1
    End If
End Function
Private Function InitAccount1()
    Dim strSql As String, recLossAccount As rdoResultset
    Dim mstrAccountSystem As String
    Dim lngID As Long, lngCnt As Long
    Dim strCode As String
    
    On Error Resume Next
    
    If fraWizard(1).Tag <> "已设置" Then
        mstrAccountSystem = gclsBase.AccountSys
        fraWizard(1).Tag = "已设置"
        
        cboDirection1.Clear
        cboDirection1.AddItem "自动转出"
        cboDirection1.AddItem "借方转出"
        cboDirection1.AddItem "贷方转出"
        
        lngID = CLng(GetSet(1, "损益结转", "个人帐户基金", 0))
        If lngID > 0 Then
            strSql = "SELECT strAccountCode FROM Account WHERE lngAccountID=" & lngID
            Set recLossAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recLossAccount.EOF Then
                strCode = recLossAccount!strAccountCode
            End If
        End If
        
        strSql = "SELECT Allaccount.lngAccountID AS ID, DECODE(Allaccount.blnIsProfitLoss,1,DECODE(InStr(Lossaccount.strAccountCode,'" & strCode & "'),1,'√',''),'') As 选择, " _
                & "Allaccount.strAccountCode || ' ' || Allaccount.strAccountName AS 转出科目, " _
                & "DECODE(Allaccount.blnIsProfitLoss,1,DECODE(InStr(Lossaccount.strAccountCode,'" & strCode & "'),1,Lossaccount.strAccountCode || ' ' || Lossaccount.strAccountName,''),'') AS 转入科目, " _
                & "DECODE(Allaccount.blnIsProfitLoss,1,Lossaccount.lngAccountID,0)  AS LossID," _
                & "DECODE(Allaccount.intLossDirection,1,'借方转出',2,'贷方转出','自动转出') As 转出方向 " _
                & "FROM Account AllAccount,Account LossAccount " _
                & " WHERE AllAccount.lngProfitLossAccountID=LossAccount.lngAccountID " _
                & " AND (AllAccount.lngAccountTypeID=" & atLoss & " OR AllAccount.lngAccountTypeID=" _
                & atCost & ") AND Allaccount.blnIsDetail AND AllAccount.blnIsInActive=0 " _
                & "ORDER BY Allaccount.strAccountCode"
        Set recLossAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        Set datLoss1.Resultset = recLossAccount
    
        Set mclsLossGrid1 = New Grid
        Set mclsLossGrid1.Grid = msgLossAccount1
        
        mclsLossGrid1.ColOfs = 2
        mclsLossGrid1.SetupStyle
        msgLossAccount1.ColWidth(0) = 0
        msgLossAccount1.ColWidth(1) = 450
        msgLossAccount1.ColWidth(2) = 2300
        msgLossAccount1.ColWidth(3) = 1800
        msgLossAccount1.ColWidth(4) = 0
        msgLossAccount1.ColWidth(5) = 900
        mclsLossGrid.SetEditText "转入科目", "", "", "", lstxtAccount1
        mclsLossGrid.SetEditText "转出方向", "", "", "", cboDirection1
        
        '转入科目参照
        RefreshAccount1
        '本年利润科目参照
        RefreshProfit1 lngID
        If lngID = 0 Then
            For lngCnt = 1 To msgLossAccount1.Rows - 1
                If C2lng(msgLossAccount1.TextMatrix(lngCnt, 4)) > 0 Then
                    If InStr(msgLossAccount1.TextMatrix(lngCnt, 3), "-") > 0 Then
                        ltxtProfit1.Text = Left(msgLossAccount1.TextMatrix(lngCnt, 3), InStr(msgLossAccount1.TextMatrix(lngCnt, 3), "-") - 1)
                    Else
                        ltxtProfit1.Text = msgLossAccount1.TextMatrix(lngCnt, 3)
                    End If
                End If
                If Trim(ltxtProfit1.Text) <> "" Then Exit For
            Next lngCnt
        End If
    End If
End Function

'第二步：凭证选项初始
Private Function InitOption()
    Dim lngID As Long
    
    If fraWizard(2).Tag <> "已设置" Then
        
        fraWizard(2).Tag = "已设置"
        lblArr(2).Caption = "请录入" & Caption & "凭证的凭证模板及凭证类型。"

        '凭证模板参照
        RefreshTemplate
        lngID = CLng(GetSet(1, "损益结转", "凭证摸板", 0))
        If lngID > 0 Then lstxtTemplate.SeekId lngID
        
        '凭证类型参照
        RefreshVoucherType
        lngID = CLng(GetSet(1, "损益结转", "凭证类型", 0))
        If lngID > 0 Then lstxtType.SeekId lngID
    End If
End Function

'第三步：生成方式初始
Private Function InitManner()
    If fraWizard(3).Tag <> "已设置" Then
        fraWizard(3).Tag = "已设置"
        optVoucher(0).Value = True
    End If
End Function

'第四步：凭证预缆初始
Private Function InitResult()
    Dim lngCnt As Long, lngCntDetail As Long, lngCntOrder As Long
    Dim strResult As String, strDetail As String, strAmount As String
    Dim strSql As String
    Dim recAccount As rdoResultset
    Dim lngLen As Long, lngSpace As Long
    
    If fraWizard(4).Tag <> "已设置" Then
        
        fraWizard(4).Tag = "已设置"
        
        '摘要参照
        If Trim$(lstxtRemark.Text) = "" Then
            strResult = Caption
        Else
            strResult = lstxtRemark.Text
        End If
        RefreshRemark
        lstxtRemark.Text = strResult
        
        '生成凭证
        GenLossVoucher
'        If Not VoucherData(0).Used Then Exit Function
        
        If UBound(VoucherData) < 100 And UBound(VoucherData(0).Detail) < 100 Then
            strResult = ""
            lngLen = 58
            For lngCnt = 0 To UBound(VoucherData)
                With VoucherData(lngCnt)
                    If .Used Then
                        For lngCntOrder = 0 To UBound(.Detail)
                            lngCntDetail = lngCntOrder
                            If .Detail(lngCntDetail).Amount <> 0 Then
                                If .Detail(lngCntDetail).Direction = adDebit Then
                                    strDetail = "借："
                                Else
                                    strDetail = "贷："
                                End If
                                strSql = "SELECT strAccountCode,strAccountName FROM Account " _
                                    & "WHERE lngAccountID=" & .Detail(lngCntDetail).AccountID
                               'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
                                Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                                If Not recAccount.EOF Then
                                    strDetail = strDetail & recAccount!strAccountCode & " " _
                                        & Trim(recAccount!strAccountName)
                                    If .Detail(lngCntDetail).CustomerID > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & CustomerName(.Detail(lngCntDetail).CustomerID)
                                    End If
                                    If .Detail(lngCntDetail).DepartmentID > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & DepartmentName(.Detail(lngCntDetail).DepartmentID)
                                    End If
                                    If .Detail(lngCntDetail).EmployeeID > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & EmployeeName(.Detail(lngCntDetail).EmployeeID)
                                    End If
                                    If .Detail(lngCntDetail).CurrencyID > 0 And .Detail(lngCntDetail).CurrencyID <> gclsBase.NaturalCurId Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & CurrencyName(.Detail(lngCntDetail).CurrencyID)
                                    End If
                                    If .Detail(lngCntDetail).ClassID1 > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & Class1Name(.Detail(lngCntDetail).ClassID1)
                                    End If
                                    If .Detail(lngCntDetail).ClassID2 > 0 Then
                                        strResult = strResult & strDetail & Chr(13) & Chr(10)
                                        strDetail = Space(4) & "— " & Class2Name(.Detail(lngCntDetail).ClassID2)
                                    End If
                                End If
                                lngSpace = lngLen - StrLen(strDetail) - 14
                                If lngSpace < 0 Then lngSpace = 0
                                strDetail = strDetail & Space(lngSpace)
                                strAmount = Format(.Detail(lngCntDetail).Amount, "#0.00")
                                lngSpace = 14 - StrLen(strAmount)
                                If lngSpace < 0 Then lngSpace = 0
                                strDetail = strDetail & Space(lngSpace) & strAmount
                                strResult = strResult & strDetail & Chr(13) & Chr(10)
                            End If
                        Next lngCntOrder
                        strResult = strResult & String(lngLen / 2, "─") & Chr(13) & Chr(10)
                    End If
                End With
            Next lngCnt
        Else
            If UBound(VoucherData) > 0 Then
                strResult = "共有" & UBound(VoucherData) + 1 & "张凭证"
            Else
                strResult = "凭证共有" & UBound(VoucherData(0).Detail) + 1 & "笔分录"
            End If
        End If
        txtResult.Text = strResult
    End If
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  向导步骤合法检查
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'第一步，损益科目
Private Function ValidAccount(Msg As String) As Boolean
    Dim lngRow As Long