standardreport.bas

金算盘软件代码

 Dim intCount As Integer
 Dim j As Integer, i As Integer
 Dim intExist As Integer
   i = 1
   For intCount = 1 To intSect
       j = InStr(i, strSource, strSeprater)
       If j = 0 Then
            i = Len(strSource) + 1
            intExist = 0
            Exit For
       Else
            i = j + 1
            intExist = 1
       End If
   Next intCount
   GetPreXStr = Left(strSource, i - 1 - intExist)
End Function
'得到帐套启用会计年度和会计期间
Public Sub GetBeginTime(intYear As Integer, intPeriod As Integer)
    Dim strSql As String
    Dim rstTime As rdoResultset
    strSql = "SELECT intYear,bytPeriod FROM AccountPeriod WHERE To_Date('" & Format(gclsBase.BeginDate, "YYYY-MM-DD") & "','YYYY-MM-DD') BETWEEN To_Date(strStartDate,'YYYY-MM-DD') AND To_Date(strEndDate,'YYYY-MM-DD')"
    Set rstTime = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstTime.EOF Then
        intYear = Year(gclsBase.BeginDate)
        intPeriod = DatePart("M", gclsBase.BeginDate)
    Else
        intYear = rstTime!intYear
        intPeriod = rstTime!bytPeriod
    End If
    Set rstTime = Nothing
End Sub

''加帮助ID
Public Sub AddHelpID(frm As Form, ByVal intGroup As Integer)
    Select Case intGroup
    Case 1
        frm.HelpContextID = 70002
    Case 2
        frm.HelpContextID = 70003
    Case 3
        frm.HelpContextID = 70003
    Case 4
        frm.HelpContextID = 70004
    Case 5
        frm.HelpContextID = 70101
    Case 6
        frm.HelpContextID = 70102
    Case 7
        frm.HelpContextID = 70005
    Case 8
        frm.HelpContextID = 70006
    Case 9
        frm.HelpContextID = 70007
    Case 10
        frm.HelpContextID = 70008
    Case 11
        frm.HelpContextID = 70009
    Case 12
        frm.HelpContextID = 70010
    Case 13
        frm.HelpContextID = 70011
    Case 14
        frm.HelpContextID = 70012
    End Select
End Sub
'得到帐套会计期间数
Public Sub GetBasePeriods(strReturnPeriod As String)
Dim strSql As String
Dim intPeriod As Integer
Dim rstPeriod As rdoResultset
    strSql = "SELECT MAX(bytPeriod) AS intPeriod FROM AccountPeriod"
    Set rstPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    intPeriod = rstPeriod!intPeriod
    strReturnPeriod = CStr(intPeriod)
    Set rstPeriod = Nothing
End Sub


'是否只有表名
Public Function OnlyTableName(ByVal strSource As String, ByVal strTableName As String) As Boolean
Dim intLoc As Integer, intStart As Integer, intLen As Integer
Dim strTemp As String
    
    If Trim(strTableName) = "" Then
        OnlyTableName = False
        Exit Function
    End If
    intLen = Len(strTableName)
    intLoc = InStr(1, strSource, ".", vbTextCompare)
    On Error Resume Next
    Do While intLoc > 0
        If intLoc > intLen Then
            If Mid(strSource, intLoc - intLen, intLen) = strTableName Then
                If intLoc > intLen + 1 Then
                    strTemp = UCase(Mid(strSource, intLoc - intLen - 1, 1))
                    If strTemp >= "A" And strTemp <= "Z" Then
                        OnlyTableName = False
                        Exit Function
                    End If
                End If
                intStart = intLoc + 1
            Else
                strTemp = UCase(Mid(strSource, intLoc - 2, 2))
                Select Case strTemp
                Case "90", "00"
                Case Else
                    OnlyTableName = False
                    Exit Function
                End Select
            End If
        Else
            OnlyTableName = False
            Exit Function
        End If
        intLoc = InStr(intStart, strSource, ".", vbTextCompare)
    Loop
    OnlyTableName = True
End Function
Public Function GetFCAlign(ByVal intHead As Integer, ByVal intIndex As Integer) As Integer
Dim intLoc As Integer
    intLoc = 0
    
    Select Case intHead
    Case 1
        intLoc = 1
    Case 2
        intLoc = intIndex * 4 - 3
    Case 3
        intLoc = intIndex * 2 - 1
    Case 4, 5
        intLoc = intIndex
    Case 6
        If intIndex < 4 Then
            intLoc = intIndex * 2 - 1
        Else
            intLoc = (intIndex - 3) * 2 + 4
        End If
    Case 7
        If intIndex < 7 Then
            intLoc = intIndex
        Else
            intLoc = 10
        End If
    Case 8
        If intIndex < 7 Then
            intLoc = intIndex
        Else
            intLoc = (intIndex - 2) * 2 - 2
        End If
    Case 9, 10, 11
        intLoc = intIndex
    Case 12
        If intIndex < 12 Then
            intLoc = intIndex
        Else
            intLoc = 15
        End If
    Case 13
        If intIndex < 13 Then
            intLoc = intIndex
        Else
            intLoc = 15
        End If
    Case 14
        If intIndex < 13 Then
            intLoc = intIndex
        Else
            intLoc = intIndex + 1
        End If
    Case Else
        intLoc = 255
    End Select
    
    If intLoc = 0 Then
        GetFCAlign = 255
    Else
        GetFCAlign = intLoc
    End If
End Function
'增强型
Public Function GetAddFCAlign(ByVal intHead As Integer, ByVal intIndex As Integer, Optional ByVal blnDate As Boolean = True) As Integer
Dim intLoc As Integer
    intLoc = 0
    
    If blnDate Then
        Select Case intHead
        Case 2
            intLoc = 1
        Case 3
            intLoc = intIndex * 2 - 1
        Case 4, 5
            intLoc = intIndex
        Case 6
            If intIndex < 3 Then
                intLoc = intIndex * 2 - 1
            Else
                intLoc = intIndex * 2
            End If
        Case 7
            If intIndex < 5 Then
                intLoc = intIndex
            Else
                intLoc = (intIndex - 4) * 4 + 2
            End If
        Case 8
            If intIndex < 5 Then
                intLoc = intIndex
            Else
                intLoc = (intIndex - 2) * 2
            End If
        Case 9, 10, 11
            If intIndex < 5 Then
                intLoc = intIndex
            Else
                intLoc = intIndex + 1
            End If
        Case 12
            If intIndex < 5 Then
                intLoc = intIndex
            ElseIf intIndex < 11 Then
                intLoc = intIndex + 1
            Else
                intLoc = 15
            End If
        Case 13
            If intIndex < 5 Then
                intLoc = intIndex
            ElseIf intIndex < 12 Then
                intLoc = intIndex + 1
            Else
                intLoc = 15
            End If
        Case 14
            If intIndex < 5 Then
                intLoc = intIndex
            ElseIf intIndex < 12 Then
                intLoc = intIndex + 1
            Else
                intLoc = intIndex + 2
            End If
        End Select
    Else
        Select Case intHead
        Case 1
            intLoc = 1
        Case 2
            intLoc = intIndex * 4 - 3
        Case 3
            intLoc = intIndex * 2 - 1
        Case 4, 5
            intLoc = intIndex
        Case 6
            If intIndex < 4 Then
                intLoc = intIndex * 2 - 1
            Else
                intLoc = (intIndex - 3) * 2 + 4
            End If
        Case 7
            If intIndex < 7 Then
                intLoc = intIndex
            Else
                intLoc = 10
            End If
        Case 8
            If intIndex < 7 Then
                intLoc = intIndex
            Else
                intLoc = (intIndex - 2) * 2 - 2
            End If
        Case 9, 10, 11
            intLoc = intIndex
        Case 12
            If intIndex < 12 Then
                intLoc = intIndex
            Else
                intLoc = 15
            End If
        Case 13
            If intIndex < 13 Then
                intLoc = intIndex
            Else
                intLoc = 15
            End If
        Case 14
            If intIndex < 13 Then