frmfixedandsalaryanaly.frm

金算盘软件代码

Private mblnIsJudge As Boolean
Private mstrAnalyCol As String
Private mblnHasDeleted As Boolean
Private mblnPassMustStep As Boolean
Private mblnIsComplete As Boolean
Private mstrOldName As String
Private mblnNewReport As Boolean
Private mblnNextStep As Boolean
Private mblnHasSalaryItem As Boolean '是否有工资项目
Private mintTempMaxStep As Integer '最后一页是否隐藏

Private Sub cboCond_Click()
    mclsFinanceRptWiz.CondShow = cboCond.ListIndex

End Sub

'将已选栏目全部加入到可选栏目中
Private Sub cmdAllToLeft_Click()
    Dim intListCount As Integer
    Dim blnIsIn As Boolean
    Dim intFixedCount As Integer
    intFixedCount = 0
    For intListCount = 0 To lstSelectedItem.ListCount - 1
        For intFixedCount = 0 To mintFixedColumns - 1
            If lstSelectedItem.list(intListCount) = mstrFixedColumnsString(intFixedCount) Then
                blnIsIn = True
            Else
                blnIsIn = False
            End If
            If blnIsIn = True Then
                Exit For
            End If
        Next intFixedCount
        If blnIsIn = False Then
            lstAll.AddItem lstSelectedItem.list(intListCount)
        End If
    Next intListCount
    intFixedCount = 0
    intListCount = lstSelectedItem.ListCount - 1
    Do While intListCount >= 0
        For intFixedCount = 0 To mintFixedColumns - 1
            If lstSelectedItem.list(intListCount) = mstrFixedColumnsString(intFixedCount) Then
                blnIsIn = True
            Else
                blnIsIn = False
            End If
            If blnIsIn = True Then
                Exit For
            End If
        Next intFixedCount
        If blnIsIn = False Then
            lstSelectedItem.RemoveItem intListCount
        End If
        intListCount = intListCount - 1
    Loop
    cmdToRight.Enabled = False
    cmdAllToRight.Enabled = True
    cmdAllToLeft.Enabled = False
    If lstSelectedItem.ListCount <= 0 Then
        cmdToLeft.Enabled = False
        cmdUpWard.Enabled = False
        cmdDownWard.Enabled = False
        cmdComplete.Enabled = False
    End If
End Sub

Private Sub cmdAllToRight_Click()
    Dim intListCount As Integer
    Dim blnIsComplete As Boolean
    For intListCount = 0 To lstAll.ListCount - 1
        lstSelectedItem.AddItem lstAll.list(intListCount)
    Next intListCount
    intListCount = lstAll.ListCount - 1
    Do While intListCount >= 0
        lstAll.RemoveItem intListCount
        intListCount = intListCount - 1
    Loop
    cmdToLeft.Enabled = False
    cmdAllToLeft.Enabled = True
    If lstAll.ListCount <= 0 Then
        cmdToRight.Enabled = False
        cmdAllToRight.Enabled = False
    End If
    ComEnabled
    If mblnIsComplete = True Then
        cmdComplete.Enabled = True
    Else
        cmdComplete.Enabled = False
    End If
End Sub

Private Sub CmdCancel_Click()
    mblnOk = False
    mintStepNow = 0
    mintTabIndex = 0
    Unload Me
End Sub

Private Sub cmdComplete_Click()
    Dim intCount As Integer
    Dim intArrIndex As Integer
    Dim strReportName As String
    Dim blnIsSameName As Boolean
    Dim frmNewReportName As New frmReportSameName
    Dim strErrString As String
    If CanComplete = False Then 'Or (mstrAnalyPeriodType = mstrReferPeriodType And (Trim(mstrAnalyPeriodType) <> "自定义" Or Trim(mstrReferPeriodType) <> "自定义")) Then
        ShowMsg Me.hWnd, "条件不足，请重新设置条件。", vbExclamation + vbOKOnly, App.title
        Exit Sub
    End If
    strReportName = txtReportName.Text
    mblnOk = True
    mclsFinanceRptWiz.ReportName = strReportName
    With lstSelectedItem
        mclsFinanceRptWiz.Columns = .ListCount
        For intCount = 0 To .ListCount - 1
            mclsFinanceRptWiz.ColumnDesc(intCount + 1) = GetNoXString(.list(intCount), 1, Space(100))
            mclsFinanceRptWiz.ColumnFieldName(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 1, "`")
            mclsFinanceRptWiz.ColumnWidth(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 2, "`")
            mclsFinanceRptWiz.ColumnIsFix(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 4, "`")
            mclsFinanceRptWiz.ColumnFieldID(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 5, "`")
            mclsFinanceRptWiz.ColumnFieldType(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 6, "`")
            mclsFinanceRptWiz.ColumnFieldSize(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 7, "`")
            mclsFinanceRptWiz.ColumnCombine(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 9, "`")
            mclsFinanceRptWiz.ColumnTableName(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 13, "`")
            mclsFinanceRptWiz.ColumnIsChoosed(intCount + 1) = 1
            mclsFinanceRptWiz.IsHeadColumn(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 10, "`")
            If Not mclsFinanceRptWiz.IsHeadColumn(intCount + 1) Then
                mclsFinanceRptWiz.DataColumns = mclsFinanceRptWiz.DataColumns + 1
            End If
                mclsFinanceRptWiz.ColumnSort(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 11, "`")
                mclsFinanceRptWiz.ColumnSortNo(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 12, "`")
                mclsFinanceRptWiz.ColumnOrderType(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 3, "`")
        Next intCount
    End With
    mclsFilter.KeyID = mclsFinanceRptWiz.ReportID
    UpdateCond
    gclsSys.SendMessage Me.hWnd, msgReport
    Unload Me
End Sub
'同一目录下报表是否同名同类型
Public Function FindSameName(ByVal strName As String, ByVal bytGroup As Byte) As Boolean
    Dim strSql As String
    Dim rstName As rdoResultset
    strSql = "SELECT * FROM Report WHERE Report.strReportName='" & strName _
             & "' And Report.bytGroup= " & bytGroup
    Set rstName = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstName.RowCount = 0 Then
        FindSameName = False
    Else
        FindSameName = True
    End If
    rstName.Close
End Function
'设置栏目顺序(向下)
Private Sub cmdDownWard_Click()
    '设置一些中间变量
    Dim intTempIndex1 As Integer
    Dim intTempIndex2 As Integer
    Dim strTempText As String
    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 = True Then Exit Sub
    intTempIndex1 = lstSelectedItem.ListIndex                       '当前所选项目的ListIndex
    strTempText = lstSelectedItem.Text                              '当前项目的Text值
    intTempIndex2 = lstSelectedItem.ListIndex + 1                   '当前项目的后一个项目
    lstSelectedItem.RemoveItem intTempIndex1
    lstSelectedItem.AddItem strTempText, intTempIndex2
    lstSelectedItem.ListIndex = lstSelectedItem.NewIndex
    If lstSelectedItem.ListIndex = lstSelectedItem.ListCount - 1 Then
        cmdDownWard.Enabled = False
    End If
End Sub
Private Sub cmdNextStep_Click()
    If mlngStepNum = 0 Then
        mlngStepNum = mlngStepNum + 1
    End If
    If mlngStepNum < mintTempMaxStep Then
       mlngStepNum = mlngStepNum + 1
    End If
    If mlngStepNum > 2 Then
        If CondIsValid = False Then
            Exit Sub
        End If
    End If
    If mlngStepNum = 3 Then
         If SalaryItemIsMultiSel = True Then
            ShowMsg Me.hWnd, "“" & mclsFinanceRptWiz.ReportName & "”只允许选择一个工资项目；若多选，默认为第一个项目。", vbInformation + vbOKOnly, App.title
            mblnNextStep = True
        End If
    End If
    ShowStep
    ComEnabled
End Sub

Private Sub cmdPriorStep_Click()
    If mlngStepNum > 1 Then
       mlngStepNum = mlngStepNum - 1
    End If
    ShowStep
    ComEnabled
End Sub

Private Sub cmdToLeft_Click()
    Dim strRemoveString As String
    Dim lstIndex As Integer
    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 = True Then Exit Sub
    lstIndex = lstSelectedItem.ListIndex
    strRemoveString = Trim(GetNoXString(lstSelectedItem.Text, 1, " "))
    If lstSelectedItem.Text <> "" Then
        lstAll.AddItem lstSelectedItem.Text
        lstSelectedItem.RemoveItem lstSelectedItem.ListIndex
        cmdToRight.Enabled = False
        cmdToLeft.Enabled = False
        cmdAllToRight.Enabled = True
        cmdUpWard.Enabled = False
        cmdDownWard.Enabled = False
    End If
    lstAll.ListIndex = lstAll.ListCount - 1
    If lstSelectedItem.ListCount > 0 Then
        If lstIndex <= lstSelectedItem.ListCount - 1 Then
            lstSelectedItem.ListIndex = lstIndex
        ElseIf lstIndex > lstSelectedItem.ListCount - 1 Then
             lstSelectedItem.ListIndex = lstIndex - 1
        End If
    End If
    If lstSelectedItem.ListCount <= 1 Then
        cmdUpWard.Enabled = False
        cmdDownWard.Enabled = False
    End If
    If mclsFinanceRptWiz.ViewId = 308 Then
        If lstSelectedItem.ListCount <= 1 Then
            cmdUpWard.Enabled = False
            cmdDownWard.Enabled = False
            cmdToLeft.Enabled = False
            cmdAllToLeft.Enabled = False
        End If
    Else
        If lstSelectedItem.ListCount <= 0 Then
            cmdToLeft.Enabled = False
            cmdAllToLeft.Enabled = False
            cmdComplete.Enabled = False
        End If
    End If
    If cmdToLeft.Enabled = True Then
        cmdToLeft.SetFocus
    End If
End Sub

Private Sub cmdToRight_Click()
    Dim lstIndex As Integer
    lstIndex = lstAll.ListIndex
    If lstAll.Text <> "" Then
        lstSelectedItem.AddItem lstAll.Text
        lstAll.RemoveItem lstAll.ListIndex
        cmdToRight.Enabled = False
        cmdToLeft.Enabled = False
        cmdAllToLeft.Enabled = True
    End If
    If lstAll.ListCount > 0 Then
        If lstIndex <= lstAll.ListCount - 1 Then
            lstAll.ListIndex = lstIndex
        ElseIf lstIndex > lstAll.ListCount - 1 Then
            lstAll.ListIndex = lstIndex - 1
        End If
    End If
    lstSelectedItem.ListIndex = lstSelectedItem.ListCount - 1
    If lstAll.ListCount <= 0 Then
        cmdToRight.Enabled = False
        cmdAllToRight.Enabled = False
    End If
    ComEnabled
    If mblnIsComplete = True Then
        cmdComplete.Enabled = True
    Else
        cmdComplete.Enabled = False
    End If
    If cmdToRight.Enabled = True Then
        cmdToRight.SetFocus
    End If
End Sub
'设置栏目顺序(向上)
Private Sub cmdUpWard_Click()
    Dim intTempIndex1 As Integer
    Dim intTempIndex2 As Integer
    Dim strTempText As String
    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 = True Then
        Exit Sub
    End If
    If lstSelectedItem.ListIndex = 1 And mclsFinanceRptWiz.ViewId = 308 Then
        Exit Sub
    End If
    intTempIndex1 = lstSelectedItem.ListIndex                       '当前所选项目的ListIndex
    strTempText = lstSelectedItem.Text                              '当前项目的Text值
    intTempIndex2 = lstSelectedItem.ListIndex - 1                   '当前项目的前一个项目
    lstSelectedItem.RemoveItem intTempIndex1
    lstSelectedItem.AddItem strTempText, intTempIndex2
    lstSelectedItem.ListIndex = lstSelectedItem.NewIndex
    If lstSelectedItem.ListIndex = 0 Then
        cmdUpWard.Enabled = False
    End If
End Sub
Private Sub Form_Activate()
    If tabWizardPages.Tab = 0 Then
        txtReportName.SetFocus
        txtReportName.SelStart = 0
        txtReportName.SelLength = Len(txtReportName.Text)
    End If
    Utility.SetHelpID 70009
End Sub
Private Sub Form_Load()
    On Error GoTo ErrHandler