frmfixedandsalaryanaly.frm

金算盘软件代码

    Set mclsHook = New Hook
    mclsHook.SetHook MsgFilter.hWnd
    
    '初始化界面
    mintTempMaxStep = mintMaxStep
    If txtReportName <> "" Then
        cmdNextStep.Enabled = True
    Else
        cmdNextStep.Enabled = False
    End If
    tabWizardPages.Tab = 0                                              '初始化页面 Tab = 0
    loadResPic
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    '设置ListText的显示格式
    Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandler:
    edtErrReturn = Errors.ErrorsDeal
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

Private Sub Form_Resize()
    If Me.Height <> lngFormHeight Then
        Me.Height = lngFormHeight
    End If
    If Me.width <> lngFormWidth Then
        Me.width = lngFormWidth
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set mclsFinanceRptWiz = Nothing
    Set mclsHook = Nothing
    Set mclsFilter = Nothing
    Erase mstrFixedColumnsString
    Erase strSelected
'    Filter.DestroyImageList ImageList1
    UnloadResPic
    mintStepNow = 0
    mintTabIndex = 0
End Sub

Private Sub lstAll_Click()
    '设置按钮 ToRight 的 Enabled 属性:只有选择一项后,才能有效
    cmdToRight.Enabled = True
    If lstAll.ListCount <= 0 Then
        cmdToRight.Enabled = False
    End If
End Sub

Private Sub lstAll_DblClick()
    cmdToRight = True
End Sub

Private Sub lstSelectedItem_Click()
    cmdToLeft.Enabled = True
    If lstSelectedItem.ListIndex = 0 Then
        cmdUpWard.Enabled = False
    Else
        cmdUpWard.Enabled = True
    End If
    If lstSelectedItem.ListIndex = lstSelectedItem.ListCount - 1 Then
        cmdDownWard.Enabled = False
    Else
        cmdDownWard.Enabled = True
    End If
End Sub

Private Sub lstSelectedItem_DblClick()
    Dim blnIsIn As Boolean
    Dim intFixedCount As Integer
    For intFixedCount = 0 To mintFixedColumns - 1
        If lstSelectedItem.Text = mstrFixedColumnsString(intFixedCount) Then
            blnIsIn = True
        Else
            blnIsIn = False
        End If
        
        If blnIsIn = True Then
            Exit For
        End If
    Next
    If blnIsIn = False Then
        cmdToLeft = True
    Else
        cmdToLeft = False
    End If
    If lstSelectedItem.ListCount <= 0 Then
        cmdToLeft.Enabled = False
    End If
End Sub
Private Sub tabWizardPages_Click(PreviousTab As Integer)
    mlngStepNum = tabWizardPages.Tab + 1
    If mlngStepNum = 2 Then
        If txtReportName.Text = "" Then
            ComEnabled
            mlngStepNum = 1
            ShowStep
            cmdNextStep.Enabled = False
            txtReportName.SetFocus
            Exit Sub
        End If
    End If
    If mlngStepNum > 2 Then
        If CondIsValid = False Then
            Exit Sub
        End If
    End If
    If mlngStepNum = 3 And mblnNextStep = False Then
        If SalaryItemIsMultiSel = True Then
            ShowMsg Me.hWnd, "“" & mclsFinanceRptWiz.ReportName & "”只允许选择一个工资项目；若多选，默认为第一个项目。", vbInformation + vbOKOnly, App.title
        End If
    End If
    mblnNextStep = False
    ComEnabled
End Sub

Private Sub tvwFilter_Collapse(ByVal Node As msComctlLib.Node)
    mclsFilter.tvwFilter_Collapse Me, Node
End Sub

Private Sub TxtFrom_KeyDown(KeyCode As Integer, Shift As Integer)
     mclsFilter.TxtFrom_KeyDown Me, KeyCode, Shift
End Sub

Private Sub txtReportName_Change()
    If Trim(txtReportName) <> "" Then
        cmdNextStep.Enabled = True
    Else
        txtReportName.Text = Trim(txtReportName)
        mlngStepNum = 1
        ShowStep
        ComEnabled
        cmdNextStep.Enabled = False
    End If
End Sub

Private Sub txtReportName_LostFocus()
    txtReportName = Trim(txtReportName)
End Sub

'初始化数据来源和数据类型
Private Sub GetDataSource()
End Sub
'涮新按钮的 Enabled 属性
Private Sub ComEnabled(Optional blnIsComplete As Boolean)
    Static blnIsSowMsg As Boolean
    Dim strErrString As String
    If mlngStepNum = 1 Then
        cmdPriorStep.Enabled = False
    Else
        cmdPriorStep.Enabled = True
    End If
    If mlngStepNum = mintTempMaxStep Then
        cmdNextStep.Enabled = False
    Else
       cmdNextStep.Enabled = True
    End If
    If mlngStepNum = mintTempMaxStep Then
       cmdComplete.Enabled = True
    Else
        If mintTempMaxStep <> 2 Then
            cmdComplete.Enabled = False
        Else
            cmdComplete.Enabled = True
        End If
    End If
    If mlngStepNum >= 2 Then
        If txtReportName = "" Then
            ShowMsg Me.hWnd, "报表名不能为空！", vbExclamation + vbOKOnly, App.title
            cmdNextStep.Enabled = False
            txtReportName.SetFocus
            mlngStepNum = 1
            ShowStep
            blnIsComplete = False
            Exit Sub
        End If
        If NameIsErr(txtReportName, strErrString) = True Then
            ShowMsg Me.hWnd, "报表名称中包含非法字符" & strErrString & "!", vbExclamation + vbOKOnly, App.title
            cmdNextStep.Enabled = False
            txtReportName.SetFocus
            mlngStepNum = 1
            ShowStep
            blnIsComplete = False
            Exit Sub
        End If
        CmdReset.Visible = True
        mblnHasDeleted = False
        mstrReferPeriodType = ""
        mstrReportPeriodType = ""
        mstrAnalyPeriodType = ""
        If MsgFilter.Rows <= 2 Then
            cmdComplete.Enabled = False
        End If
    Else
        CmdReset.Visible = False
    End If
    If CanComplete = False Then ' Or (mstrAnalyPeriodType = mstrReferPeriodType And (Trim(mstrAnalyPeriodType) <> "自定义" Or Trim(mstrReferPeriodType) <> "自定义")) Then
        If mintTempMaxStep > 2 Then
            cmdComplete.Enabled = False
        Else
            cmdComplete.Enabled = True
        End If
        mblnIsComplete = False
    Else
        cmdComplete.Enabled = True
        mblnIsComplete = True
    End If
End Sub
'工资项目是否多选
Private Function SalaryItemIsMultiSel() As Boolean
    Dim intCount As Integer
    If mclsFinanceRptWiz.AccountTypeID < 25 Then
        Exit Function
    End If
    For intCount = 0 To MsgFilter.Rows - 1
        If MsgFilter.TextMatrix(intCount, 0) = "工资项目" Then
            If InStr(1, MsgFilter.TextMatrix(intCount, 1), ",") > 0 Then
                SalaryItemIsMultiSel = True
            Else
                SalaryItemIsMultiSel = False
            End If
            Exit For
        End If
    Next
End Function
Private Function CondIsValid() As Boolean
    Dim blnIsTrue As Boolean
    Dim intResponseID As Integer
    Dim strMessage As String
    Dim blnIscheckedType As Boolean
    Dim lngPositionLine As Long
    If mlngStepNum >= 3 Then
        mblnIsPeriodOver = PeriodCond
        blnIsTrue = JudgeIsInPeriod
        If mblnIsPeriodOver = False Or mblnHasSalaryItem = False Then
            If mclsFinanceRptWiz.IsOnlyAnalyPeriod = False And mblnIsPeriodOver = False Then
'                strMessage = "分析期是生成报表的必需条件，且必需比较期和报告期中的一个。" & Chr(13) & "请重新设置。"
                strMessage = "分析条件必须选择比较期或者报告期。" & Chr(13) & "请重新设置。"
            ElseIf mclsFinanceRptWiz.ViewId = 247 And mblnHasSalaryItem = False Then
                strMessage = "该报表需要指定工资项目。" & Chr(13) & "请重新设置。"
            End If
            ShowMsg Me.hWnd, strMessage, vbExclamation + vbOKOnly, App.title
            mlngStepNum = 2
            ShowStep
            ComEnabled
            CondIsValid = False
            Exit Function
        End If
        If mstrReportPeriodType <> "" And mstrReferPeriodType <> "" And mblnHasDeleted = False Then
            strMessage = "比较期和报告期二者中只允许一个成为生成报表的条件 。" & Chr(13) & Chr(13) & "按下“是”保留比较期，按下“否”保留报告期。" & Chr(13) & Chr(13) & "保留比较期而去掉报告期吗？"
            intResponseID = ShowMsg(Me.hWnd, strMessage, vbQuestion + vbDefaultButton1 + vbYesNo, App.title)
            If intResponseID = vbYes Then
                lngPositionLine = mclsFilter.PositionLine(Me, "报告期")
                mclsFilter.DelLine Me, lngPositionLine
            ElseIf intResponseID = vbNo Then
                lngPositionLine = mclsFilter.PositionLine(Me, "比较期")
                mclsFilter.DelLine Me, lngPositionLine
            End If
            mblnHasDeleted = True
        End If
        If mstrAnalyPeriodType = mstrReferPeriodType And Trim(mstrAnalyPeriodType) <> "自定义" And mstrAnalyPeriodType <> "" Then
            strMessage = "分析期与比较期类型相同，请重新设置。"
            ShowMsg Me.hWnd, strMessage, vbExclamation + vbOKOnly, App.title
            mlngStepNum = 2
            ShowStep
            ComEnabled
            CondIsValid = False
            Exit Function
        End If
    End If
    CondIsValid = True
End Function

Private Sub ShowStep()
    tabWizardPages.Tab = mlngStepNum - 1
End Sub

'计算生选择的条件是否足以生成一张报表,是则返回 真,否则,返回 假
Private Function CanComplete() As Boolean
    Dim blnHasReportName As Boolean                     '是否有报表名称
    Dim blnHasChoosed As Boolean                        '是否选择了报表的栏目
    Dim blnChkDataSource As Boolean                     '是否选择了数据类型
    Dim blnHasPeriodCond As Boolean                     '是否有报告期,比较期中的一种
    Dim blnHasChoosedVol As Boolean                     '纵向分析时,是否选择了分析列
    Dim blnHasChooseDataType As Boolean
    If txtReportName.Text <> "" Then
        blnHasReportName = True
    Else
        blnHasReportName = False
    End If
    If lstSelectedItem.ListCount > 0 Then
        blnHasChoosed = True
    Else
        blnHasChoosed = False
    End If
    If PeriodCond = True And blnHasChoosed = True And blnHasReportName = True And mlngStepNum > 1 Then
        CanComplete = True
    Else
        CanComplete = False
    End If
End Function

'判断生成报表的必需的期间是否都存在(分析期必须有,比较期与报告期两者必选其一)
Private Function PeriodCond() As Boolean
    Dim blnHasAnalyPeriod As Boolean
    Dim blnHasReportPeriod As Boolean
    Dim blnHasReferPeriod As Boolean
    Dim intCount As Integer
    Dim intColIndex As Integer
    Dim intArrCount As Integer
    Dim blnReturnCond As Boolean
    Dim blnIsSpecialReport As Boolean
    Select Case mclsFinanceRptWiz.AccountTypeID
        Case 20 To 23, 27
            blnIsSpecialReport = True
        Case Else
            blnIsSpecialReport = False
    End Select
    blnReturnCond = mclsFilter.GetSelectd(strSelected())
    If blnReturnCond = False Then
        Select Case mclsFinanceRptWiz.AccountTypeID
            Case 25, 26, 27
                mblnHasSalaryItem = False
            Case Else
                mblnHasSalaryItem = True
        End Select
        If blnIsSpecialReport = True Then
            PeriodCond = True
        Else
            PeriodCond = False
        End If
        blnHasAnalyPeriod = True
        Exit Function
    End If
    intArrCount = UBound(strSelected)
    Select Case mclsFinanceRptWiz.AccountTypeID
        Case 25, 26, 27
            intCount = 1
            Do While intCount < MsgFilter.Rows - 1