frmfixedandsalaryanaly.frm

金算盘软件代码

                If strSelected(intCount, 1) = "工资项目" Then
                    mblnHasSalaryItem = True
                    Exit Do
                Else
                    mblnHasSalaryItem = False
                End If
                intCount = intCount + 1
            Loop
        Case Else
            mblnHasSalaryItem = True
    End Select
    intCount = 1
    Do While intCount < MsgFilter.Rows - 1
        If strSelected(intCount, 1) = "分析期" Then
            blnHasAnalyPeriod = True
            mstrAnalyPeriodType = strSelected(intCount, 5)
            Exit Do
        End If
        intCount = intCount + 1
    Loop
    intCount = 1
    blnHasAnalyPeriod = True
    Do While intCount < MsgFilter.Rows - 1
        If strSelected(intCount, 1) = "比较期" Then
            blnHasReferPeriod = True
            mstrReferPeriodType = strSelected(intCount, 5)
            Exit Do
        End If
        intCount = intCount + 1
    Loop
    If blnHasReferPeriod = False Then
        intCount = 1
        Do While intCount < MsgFilter.Rows - 1
            If strSelected(intCount, 1) = "报告期" Then
                blnHasReportPeriod = True
                mstrReportPeriodType = strSelected(intCount, 5)
                Exit Do
            End If
            intCount = intCount + 1
        Loop
    End If
    If blnHasReferPeriod = True Or blnHasReportPeriod = False Then
        mblnReportPeriodCond = False
    ElseIf blnHasReportPeriod = True Then
        mblnReportPeriodCond = True
    End If
    Select Case mclsFinanceRptWiz.ViewId
        Case 544, 547 '247, 361 To 367,
            If mclsFinanceRptWiz.AccountTypeID <> 18 Then
                If blnHasAnalyPeriod = True Then
                    PeriodCond = True
                Else
                    PeriodCond = False
                End If
            Else
                If (blnHasAnalyPeriod = True And blnHasReferPeriod = True) Or (blnHasAnalyPeriod = True And blnHasReportPeriod = True) Then
                    PeriodCond = True
                Else
                    PeriodCond = False
                End If
            End If
        Case Else
            If (blnHasAnalyPeriod = True And blnHasReferPeriod = True) Or (blnHasAnalyPeriod = True And blnHasReportPeriod = True) Or (blnHasAnalyPeriod = True And blnIsSpecialReport = True) Then
                PeriodCond = True
            Else
                PeriodCond = False
            End If
    End Select
End Function

'判断所选期间是否正好属于一个会计期间
Private Function JudgeIsInPeriod() As Boolean
    Dim strAnalyBegin As String
    Dim strAnalyEnd As String
    Dim strReferBegin As String
    Dim strReferEnd As String
    Dim intCount As Integer
    Dim dtmRealBegin As Date
    Dim dtmRealEnd As Date
    Dim intPeriodID As Integer
    Dim strReportPeriod As String
    Dim blnHasReferPeriod As Boolean
    Dim blnReturnCond As Boolean
    Dim intArrCount As Integer
    blnReturnCond = mclsFilter.GetSelectd(strSelected())
    If blnReturnCond = False Then
        Exit Function
    End If
    intArrCount = UBound(strSelected)
    For intCount = 1 To MsgFilter.Rows - 2
        If strSelected(intCount, 1) = "分析期" Then
            strAnalyBegin = strSelected(intCount, 6)
            strAnalyEnd = strSelected(intCount, 7)
            mstrAnalyPeriodType = strSelected(intCount, 5)
            Exit For
        End If
    Next
    For intCount = 1 To MsgFilter.Rows - 2
        If strSelected(intCount, 1) = "比较期" Then
            strReferBegin = strSelected(intCount, 6)
            strReferEnd = strSelected(intCount, 7)
            mstrReferPeriodType = strSelected(intCount, 5)
            blnHasReferPeriod = True
            Exit For
        End If
    Next
    For intCount = 1 To MsgFilter.Rows - 2
        If strSelected(intCount, 1) = "报告期" Then
            strReportPeriod = strSelected(intCount, 5)
            mstrReportPeriodType = strReportPeriod
            Exit For
        End If
    Next
    '分析分析期
    If strAnalyBegin = "" Or strAnalyEnd = "" Then
        JudgeIsInPeriod = False
        Exit Function
    End If
    intPeriodID = gclsBase.PeriodOfDate(CDate(strAnalyBegin), dtmRealBegin, dtmRealEnd)
    If CDate(strAnalyBegin) <> dtmRealBegin Then
        JudgeIsInPeriod = False
        Exit Function
    End If
    intPeriodID = gclsBase.PeriodOfDate(CDate(strAnalyEnd), dtmRealBegin, dtmRealEnd)
    If CDate(strAnalyEnd) <> dtmRealEnd Then
        JudgeIsInPeriod = False
        Exit Function
    End If
    '分析比较期
    If strReferBegin <> "" And strReferEnd <> "" Then
        intPeriodID = gclsBase.PeriodOfDate(CDate(strReferBegin), dtmRealBegin, dtmRealEnd)
        If CDate(strReferBegin) <> dtmRealBegin Then
            JudgeIsInPeriod = False
            Exit Function
        End If
        intPeriodID = gclsBase.PeriodOfDate(CDate(strReferEnd), dtmRealBegin, dtmRealEnd)
        If CDate(strReferEnd) <> dtmRealEnd Then
            JudgeIsInPeriod = False
            Exit Function
        End If
    ElseIf strReportPeriod <> "" Then
        If Trim(strReportPeriod) <> "期" Then
            JudgeIsInPeriod = False
            Exit Function
        End If
    ElseIf strReportPeriod = "" Then
        JudgeIsInPeriod = False
        Exit Function
    End If
    mblnIsJudge = True
    JudgeIsInPeriod = True
End Function
'仅对于工资项目增长情况表。
Private Sub SetViewField(ByVal lngViewId As Long, ByVal bytAccountTypeID As Byte, Optional strViewFieldDesc As String = "")
    Dim strSql As String
    Select Case lngViewId
        Case 247
            Select Case bytAccountTypeID  '= 19 Then
                Case 19 '工资增长情况表
                    '置比较期为筛选条件
                    strSql = "Update ViewField Set ViewField.blnIsFilter = 1 Where ViewField.lngViewID = 247 And  ViewField.lngViewFieldID = 18176 "
                    gclsBase.ExecSQL strSql
                    '置报告期不为筛选条件
                    strSql = "Update ViewField Set ViewField.blnIsFilter = 0 Where ViewField.lngViewID = 247 And ViewField.lngViewFieldID = 11172"
                    gclsBase.ExecSQL strSql
                Case 27, 20 To 23 '工资结构分析表
                    '置报告期不为筛选条件
                    strSql = "Update ViewField Set ViewField.blnIsFilter = 0 Where ViewField.lngViewID = 247 And ViewField.lngViewFieldID = 11172"
                    gclsBase.ExecSQL strSql
                    '置比较期不为筛选条件
                    strSql = "Update ViewField Set ViewField.blnIsFilter = 0 Where ViewField.lngViewID = 247 And  ViewField.lngViewFieldID = 18176 "
                    gclsBase.ExecSQL strSql
                Case Else
                    strSql = "Update ViewField Set ViewField.blnIsFilter = 0 Where ViewField.lngViewID = 247 And  ViewField.lngViewFieldID = 18176 "
                    gclsBase.ExecSQL strSql
                    strSql = "Update ViewField Set ViewField.blnIsFilter = 1 Where ViewField.lngViewID = 247 And ViewField.lngViewFieldID = 11172"
                    gclsBase.ExecSQL strSql
            End Select
        Case Else
            Exit Sub
    End Select
End Sub
'初始化报表设置(从数据库中读出数据 ,并显示在向导上)
Public Function SetReport(clsReportSet As FinanceReportWizard, Optional clsFilter As FormCond) As Boolean
    Dim blnIsFromWizard  As Boolean
    Dim intFixedCount As Integer
    MsgForm.PleaseWait "正在调用向导，请稍候 . . ."
    Set mclsFinanceRptWiz = clsReportSet
    blnIsFromWizard = mclsFinanceRptWiz.ReportIsFromWizard
    SetViewField mclsFinanceRptWiz.ViewId, mclsFinanceRptWiz.AccountTypeID
    If clsFilter Is Nothing Then
      Set clsFilter = New FormCond
      clsFilter.InitCondArr mclsFinanceRptWiz.ReportID, mclsFinanceRptWiz.ViewId
    End If
    Set mclsFilter = clsFilter
    tvwFilter.ImageList = frmMain.ImageListFilter
    mclsFilter.ShowFilter Me, mclsFinanceRptWiz.ReportID, 2
    '设置视图项目中的作为条件的记录
    txtReportName = mclsFinanceRptWiz.ReportName
    Caption = mclsFinanceRptWiz.ReportName & "查询向导"
    mstrOldName = mclsFinanceRptWiz.ReportName
    mblnNewReport = mclsFinanceRptWiz.IsNewReport
    ReGetChoosed
    GetMayChoose
    InitCondShow
    cboCond.ListIndex = mclsFinanceRptWiz.CondShow
    
    SetFixedInterface mclsFinanceRptWiz.ViewId, mclsFinanceRptWiz.AccountTypeID
    Set clsFilter = mclsFilter
    '重新定义保存固定栏目的数组
    mintFixedColumns = mclsFinanceRptWiz.FixColumns
    ReDim mstrFixedColumnsString(mintFixedColumns) As String
    For intFixedCount = 0 To mintFixedColumns - 1
        mstrFixedColumnsString(intFixedCount) = lstSelectedItem.list(intFixedCount)
    Next
    Unload MsgForm
    Me.Show vbModal
    If mblnOk Then
       SetReport = True
    Else
        If blnIsFromWizard = False Then
            Set clsFilter = Nothing
        End If
    End If
    Set clsReportSet = mclsFinanceRptWiz
End Function
Private Sub InitCondShow()
    cboCond.AddItem "不显示", 0
    cboCond.AddItem "表头显示", 1
    cboCond.AddItem "表尾显示", 2
End Sub
'以下对应为条件控件过程
'保存条件到数据库
Private Sub UpdateCond()
'    mclsFilter.UpdateCond
    UpdateCondOfClass
End Sub
'更新类中的条件属性.
Private Sub UpdateCondOfClass()
    Dim intCount As Integer
    Dim blnReturnCond As Boolean
    Dim strQueryCond As String
    Dim strReportName As String
    strReportName = txtReportName.Text
    If mclsFinanceRptWiz.ReportName <> strReportName Then
        mclsFinanceRptWiz.ReportName = strReportName
    End If
    blnReturnCond = mclsFilter.GetSelectd(strSelected())
    mclsFinanceRptWiz.CondShowing = ""
    If blnReturnCond = True Then
        mclsFinanceRptWiz.CondCount = UBound(strSelected())
        For intCount = 0 To mclsFinanceRptWiz.CondCount - 1
            mclsFinanceRptWiz.CondDesc(intCount) = strSelected(intCount + 1, 1)
            mclsFinanceRptWiz.CondValue(intCount) = strSelected(intCount + 1, 5)
            If strSelected(intCount + 1, 3) = "PERIOD" Then
                mclsFinanceRptWiz.CondPeriodStart(intCount) = CDate(strSelected(intCount + 1, 6))
                mclsFinanceRptWiz.CondPeriodEnd(intCount) = CDate(strSelected(intCount + 1, 7))
            End If
            mclsFinanceRptWiz.CondWhere(intCount) = strSelected(intCount + 1, 8)
            If strSelected(intCount + 1, 3) <> "PERIOD" And strSelected(intCount + 1, 1) <> "报告期" Then
                If mclsFinanceRptWiz.CondShowing = "" Then
                    If strSelected(intCount + 1, 5) <> "选择项目" Then
                        mclsFinanceRptWiz.CondShowing = strSelected(intCount + 1, 11) & "： " & strSelected(intCount + 1, 5)
                    Else
                        mclsFinanceRptWiz.CondShowing = strSelected(intCount + 1, 11) & "： " & strSelected(intCount + 1, 7)
                    End If
                Else
                    If strSelected(intCount + 1, 5) <> "选择项目" Then
                        mclsFinanceRptWiz.CondShowing = mclsFinanceRptWiz.CondShowing & "         " & strSelected(intCount + 1, 11) & "： " & strSelected(intCount + 1, 5)
                    Else
                        mclsFinanceRptWiz.CondShowing = mclsFinanceRptWiz.CondShowing & "         " & strSelected(intCount + 1, 11) & "： " & strSelected(intCount + 1, 7)
                    End If
                End If
            End If
        Next
    Else
        mclsFinanceRptWiz.CondCount = 0
    End If
End Sub
Private Sub SetFixedInterface(ByVal ViewId As Long, Optional ByVal bytAccountTypeID As Byte = 0)
    Dim intCount  As Integer
    Select Case ViewId
        Case 247
        Case 308
            If bytAccountTypeID <> 17 Then
                fraColumnsSet.Enabled = True
                tabWizardPages.TabVisible(2) = True
                mintTempMaxStep = 3
            Else
                fraColumnsSet.Enabled = False
                tabWizardPages.TabVisible(2) = False
                mintTempMaxStep = 2
            End If
    End Select
    Select Case bytAccountTypeID
        Case 18, 19 '工资项目统计表、工资项目增长情况表
            fraColumnsSet.Visible = False
            tabWizardPages.TabVisible(2) = False
            mintTempMaxStep = 2
    End Select
End Sub

'取可选栏目
Private Sub GetMayChoose()
    Dim rstMayChoose As rdoResultset
    Dim strSql As String
   Dim strChoosed As String
   Dim intCount As Integer
   For intCount = 1 To mclsFinanceRptWiz.Columns
       If strChoosed = "" Then
            strChoosed = "'" & mclsFinanceRptWiz.ColumnDesc(intCount) & "'"
       Else
            strChoosed = strChoosed & ",'" & mclsFinanceRptWiz.ColumnDesc(intCount) & "'"
       End If
   Next intCount
    lstAll.Clear
    'And blnIsChoosed=False
    strSql = "Select * from ViewField,ReportField " & _
            "Where ViewField.lngViewFieldID=ReportField.lngViewFieldID " & _
             " And lngReportID=" & mclsFinanceRptWiz.ReportID & _
             " And (Not ReportField.strReportFieldDesc IN (" & strChoosed & "))"
    Set rstMayChoose = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstMayChoose
        Do While Not .EOF
                lstAll.AddItem !strReportFieldDesc & Space(100) & !strFieldName & "`" & _
                            !lngDisplayWidth & "`" & 0 & "`" & !blnIsFixed & "`" & _
                            !lngViewFieldID & "`" & !strFieldType & "`" & !bytFieldSize & "`" & _
                            False & "`" & !strCombine & "`" & IIf(!blnIsHeaded = 1, True, False) & "`" & _
                            !bytsort & "`" & !intSortNo & "`" & !strTableName & "`" & 0 & "`" & _
                            0 & "`"
                .MoveNext
        Loop
        .Close
    End With
    If lstAll.ListCount > 0 Then
        cmdAllToRight.Enabled = True
    Else
        cmdAllToRight.Enabled = False
    End If
End Sub

'通过类的属性取已选栏目
Private Sub ReGetChoosed()
    Dim intC