frmend.frm

金算盘软件代码

''''''''''''''''''''''''''''''''

'第一步：会计期间初始
Private Sub InitPeriod()
    If fraend(0).Tag <> "已设置" Then
        Dim strSql As String, recPeriod As rdoResultset
        Dim lngCnt As Long, lngCol As Long
        
        strSql = "SELECT ' ' AS ID, " _
                & "intYear || '.' || LPAD(bytPeriod,2,'0') AS 期间, " _
                & "DECODE(SIGN(lngCloseID),1,'√','') AS 结帐, " _
                & "strCloseDate AS 日期, " _
                & "strOperatorName AS 操作员 "
        strSql = strSql & " FROM AccountPeriod,Operator " _
                & " WHERE AccountPeriod.lngCloseID=Operator.lngOperatorID(+) " _
                & " AND intYear=" & gclsBase.FYearOfDate(gclsBase.BaseDate)

        Set recPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        Set datPeriod.Resultset = recPeriod
        
        fraend(0).Tag = "已设置"
        
        Set mclsPeriodGrid = New Grid
        Set mclsPeriodGrid.Grid = msgPeriod
        mclsPeriodGrid.ColOfs = 1
        mclsPeriodGrid.SetupStyle
        msgPeriod.ColWidth(0) = 0
        msgPeriod.ColWidth(1) = 800
        msgPeriod.ColWidth(2) = 500
        msgPeriod.ColWidth(3) = 1100
        msgPeriod.ColWidth(4) = 900
        
        If gclsBase.AccountYear = mintStartYear Then
            msgPeriod.ColAlignment(2) = 4
            For lngCnt = 1 To mintStartPeriod - 1
                msgPeriod.TextMatrix(lngCnt, 2) = "—"
            Next lngCnt
        End If
        For lngCnt = 1 To msgPeriod.Rows - 1
            If Trim(msgPeriod.TextMatrix(lngCnt, 2)) = "" Then
                msgPeriod.Row = lngCnt
                Exit For
            End If
        Next lngCnt
        If gclsBase.AccountYear = mintStartYear And lngCnt < gclsBase.Period Then
            For lngCnt = 1 To msgPeriod.Rows - 1
                If Trim(msgPeriod.TextMatrix(lngCnt, 1)) = mintStartYear & "." & Format(mintStartPeriod, "00") Then
                    msgPeriod.Row = lngCnt
                    Exit For
                End If
            Next lngCnt
        End If
        msgPeriod.col = 0
        msgPeriod.ColSel = 4
    End If
    Set recPeriod = Nothing
End Sub


'第二步：结帐报告初始
Private Function InitReport()
    Dim strSql As String
    Dim qrfBalance As rdoQuery
    Dim recBusiness As rdoResultset, recTmp As rdoResultset
    Dim strFirstNote As String, strSecondNote As String
    Dim strOtherNote As String, lngLen As Long
    Dim strFirstNum As String, strSecondNum As String
    Dim dblFirstNum As Double, dblSecondNum As Double
    Dim IntSpace As Integer, strNote As String
    Dim dtmStart As Date, dtmEnd As Date
    Dim strCompChar As String, blnBalance As Boolean
    Dim strQAccountBalanceSql As String, strTmp As String
    
    '取本会计期间的起止日期
    gclsBase.DateOfPeriod mintYear, mintPeriod, dtmStart, dtmEnd

    If fraend(1).Tag <> "已设置" Then
        fraend(1).Tag = "已设置"
        Select Case gclsBase.AccountSys
        Case "1" '企业单位
            GetFactary strFirstNote, strSecondNote, strFirstNum, strSecondNum, dblFirstNum, dblSecondNum
            strOtherNote = GetGain()
        Case "2" '事业单位
            GetManage strFirstNote, strSecondNote, strFirstNum, strSecondNum, dblFirstNum, dblSecondNum
        Case "3" '行政单位
            GetAdministor strFirstNote, strSecondNote, strFirstNum, strSecondNum, dblFirstNum, dblSecondNum
        Case "4" '医疗
            GetPrivate strFirstNote, strSecondNote, strFirstNum, strSecondNum, dblFirstNum, dblSecondNum
        Case "5" '社会保险
            GetAdministor strFirstNote, strSecondNote, strFirstNum, strSecondNum, dblFirstNum, dblSecondNum
        End Select
        
        If Abs(dblFirstNum - dblSecondNum) < 10 ^ (-gclsBase.NaturalCurDec) Then
            strCompChar = "＝"
        ElseIf dblFirstNum > dblSecondNum Then
            strCompChar = "> "
        Else
            strCompChar = "< "
        End If
    
        strNote = strNote & "                   本期间工作简报                   " & Chr(13) & Chr(10)
        strNote = strNote & "───────────┬──┬───────────" & Chr(13) & Chr(10)
        lngLen = 22
        If Len(strFirstNum) > 22 Then
            strFirstNum = String(lngLen, "*")
        End If
        If Len(strSecondNum) > 22 Then
            strSecondNum = Format(dblSecondNum, "#,0.00")
            If Len(strSecondNum) > 22 Then strSecondNum = String(lngLen, "*")
        End If
        IntSpace = IIf(lngLen > StrLen(strFirstNote), (lngLen - StrLen(strFirstNote)) / 2, 0)
        strNote = strNote & Space(IntSpace) & strFirstNote & Space(lngLen - IntSpace _
            - StrLen(strFirstNote)) & "│    │"
        IntSpace = IIf(lngLen > StrLen(strSecondNote), (lngLen - StrLen(strSecondNote)) / 2, 0)
        strNote = strNote & Space(IntSpace) & strSecondNote & Chr(13) & Chr(10)
        strNote = strNote & "───────────┼──┼───────────" & Chr(13) & Chr(10)
        IntSpace = IIf(lngLen > Len(strFirstNum), (lngLen - Len(strFirstNum)) / 2, 0)
        strNote = strNote & Space(IntSpace) & strFirstNum & Space(lngLen - IntSpace _
            - Len(strFirstNum)) & "│ " & strCompChar & " │"
        IntSpace = IIf(lngLen > Len(strSecondNum), (lngLen - Len(strSecondNum)) / 2, 0)
        strNote = strNote & Space(IntSpace) & strSecondNum & Chr(13) & Chr(10)
        strNote = strNote & "───────────┴──┴───────────" & Chr(13) & Chr(10)
        If strOtherNote <> "" Then
            IntSpace = (2 * lngLen - StrLen(strOtherNote) - 8) / 2
            If IntSpace < 0 Then IntSpace = 0
            strNote = strNote & Space(IntSpace) & strOtherNote & Chr(13) & Chr(10)
            strNote = strNote & "──────────────────────────" & Chr(13) & Chr(10)
        End If
        
        '凭证缺号

        strNote = strNote & GetVoucherLostNo(lngLen * 2 + 8) & Chr(13) & Chr(10)
        
'        1 = "金算盘财务及企业管理软件(标准版)"
'        2 = "金算盘财务及企业管理软件(行政事业版)"
'        4 = "金算盘商务管理软件(实达专用版)"
'        8= "金算盘商务管理软件(标准版)"
         
         If mstrMsgVoucher <> "" Then
            strNote = strNote & mstrMsgVoucher & Chr(13) & Chr(10)
         End If
        
        '本期间未期末调汇
        strSql = "SELECT lngVoucherID FROM Voucher WHERE lngVoucherSourceID=" & vsTransloss _
            & " AND intYear=" & mintYear & " AND bytPeriod=" & mintPeriod
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTmp.EOF Then
            strSql = "SELECT lngAccountID FROM Account WHERE blnIsInActive=0 AND (blnIsMultCurrency=1 OR blnIsAllCurrency=1)"
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                strNote = strNote & "本期间未期末调汇！" & Chr(13) & Chr(10)
            End If
        End If
        recTmp.Close
        
        '损益类(收入支出)科目未结平
        strQAccountBalanceSql = TransferPublic.getQAccountBalanceOraSql(Format(mdtmEnd, "yyyy-mm-dd"))
        strSql = "SELECT Account.lngAccountID,strAccountCode,lngCustomerID,lngDepartmentID," _
            & "lngEmployeeID,lngClassID1,lngClassID2,intDirection," _
            & "SUM(dblPostedDebit-dblPostedCredit) AS Amount " _
            & "FROM ( " & strQAccountBalanceSql & " ) QAccountBalance,Account " _
            & "WHERE QAccountBalance.lngAccountID=Account.lngAccountID(+) "
        If mstrAccountSystem = "2" Or mstrAccountSystem = "3" Or mstrAccountSystem = "4" Or mstrAccountSystem = "5" Then
            strSql = strSql & " AND (Account.lngAccountTypeID=" & atLoss & " OR Account.lngAccountTypeID=" & atCost & ") "
        Else
            strSql = strSql & " AND Account.lngAccountTypeID=" & atLoss & " "
        End If
        strSql = strSql & " GROUP BY Account.lngAccountID,strAccountCode,lngCustomerID,lngDepartmentID," _
            & "lngEmployeeID,lngClassID1,lngClassID2,intDirection " _
            & "HAVING ABS(SUM(dblPostedDebit-dblPostedCredit))>0.00001"
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        blnBalance = recTmp.EOF
        If Not blnBalance Then
            Select Case mstrAccountSystem
            Case "1"
                strNote = strNote & "损益类科目未结平！" & Chr(13) & Chr(10)
            Case "2"
                strNote = strNote & "收入支出类科目未结平！" & Chr(13) & Chr(10)
            Case "3"
                strNote = strNote & "收入支出类科目未结平！" & Chr(13) & Chr(10)
            Case "4"
                strNote = strNote & "收支类科目未结平！" & Chr(13) & Chr(10)
            Case "5"
                strNote = strNote & "收入支出类科目未结平！" & Chr(13) & Chr(10)
            End Select
        End If
        recTmp.Close
        
        txtReport.Text = strNote
    End If
    Set recBusiness = Nothing
    Set recTmp = Nothing
End Function

'第三步：执行结帐初始
Private Function InitOver()
    Dim lngCnt As Integer
End Function

''''''''''''''''''''''''''''''''
'
' 合法检查
'
''''''''''''''''''''''''''''''''

'第一步：会计期间合法检查
Private Function ValidPeriod(Msg As String) As Boolean
    Dim intYear As Integer, intPeriod As Integer
    Dim dtmStart As Date, dtmEnd As Date
    Dim lngID As Long, strCode As String
    Dim recTmp As rdoResultset, recPeriod As rdoResultset
    Dim recZ As rdoResultset
    Dim qrfBalance As rdoQuery, qrfItem As rdoQuery
    Dim strSql As String
    Dim strQAccountBalanceSql As String, strTmp As String
    Dim strQItemCostItemSql As String
    Dim strQItemCostNotCalcSql As String
    
    ValidPeriod = True
    mstrMsgVoucher = ""
    
    '短开绑定数据
    Set datPeriod.Resultset = Nothing
    
    If msgPeriod.Rows = msgPeriod.FixedRows Then
        ValidPeriod = False
        Msg = "没有期间！"
    End If
    
    With msgPeriod
        If .ColSel <= .col Or (Not IsNumeric(Mid(.TextMatrix(.Row, 1), 1, 4))) Or (Not IsNumeric(Mid(.TextMatrix(.Row, 1), 6, 2))) Then
            ValidPeriod = False
            Msg = "请指定会计期间！"
        End If
    End With
    
    '当前会计期间
    If ValidPeriod Then
        With msgPeriod
            intYear = CInt(Mid(.TextMatrix(.Row, 1), 1, 4))
            intPeriod = CInt(Mid(.TextMatrix(.Row, 1), 6, 2))
        End With
    End If
            
    If mintYear = mintStartYear And intPeriod < mintStartPeriod Then
        ValidPeriod = False
        Msg = "会计期间不能小于帐套启用期间！"
    End If
    
    '检查上期是否结帐
    If ValidPeriod Then
        With msgPeriod
            
            '清除结帐报告
            If mintYear <> intYear Or mintPeriod <> intPeriod Then
                mintPeriod = intPeriod
                fraend(1).Tag = ""
            End If
            gclsBase.DateOfFanYear mintYear, mdtmFirst
            gclsBase.DateOfPeriod mintYear, mintPeriod, , mdtmEnd
            
            strSql = "SELECT bytPeriodNO FROM AccountYear WHERE intYear=" & mintYear
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                mintPeriodNum = recTmp!bytPeriodNO
            End If
            
            '上一会计期间
            If mintYear <> mintStartYear Or mintPeriod <> mintStartPeriod Then
                intYear = mintYear
                intPeriod = mintPeriod
                If intPeriod = 1 Then
                    intPeriod = mintPeriodNum
                    intYear = intYear - 1
                Else
                    intPeriod = intPeriod - 1
                End If
                
                strSql = "SELECT lngCloseID FROM AccountPeriod WHERE intYear=" _
                        & intYear & " AND bytPeriod=" & intPeriod
                        
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recTmp.EOF Then
                    If recTmp!lngCloseID = 0 Then
                        ValidPeriod = False
                        Msg = "上期未结帐,本期不能结帐！"
                    End If
                End If
                recTmp.Close
            End If
        End With
    End If
    
    '检查本期是否结帐
    If ValidPeriod Then
        With msgPeriod
            If .TextMatrix(.Row, 2) = "√" Then
                ValidPeriod = False
                Msg = "本期已经结帐！"
            End If
        End With
    End If
    
    '取本会计期间的起止日期
    gclsBase.DateOfPeriod mintYear, mintPeriod, dtmStart, dtmEnd