frmsalarydevelopwizard.frm

金算盘软件代码

         TabIndex        =   10
         Top             =   390
         Width           =   1575
      End
      Begin VB.Label LblData 
         Caption         =   "数据项目(&D)"
         Height          =   225
         Left            =   -73350
         TabIndex        =   4
         Top             =   390
         Width           =   1035
      End
   End
End
Attribute VB_Name = "frmSalaryDevelopWizard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'  工资发放表设置向导
'  作者: 邹俊
'  日期 ： 1998. 11. 12

Option Explicit
Private WithEvents mclsMainControl As MainControl   '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsFilter As FormCond            '查询条件类
Private Const mlngSalaryReportID = 1463   '工资发放表ID
Private Const mlngViewID = 63             '工资视图ID
Private Const mlngFilterViewID = 72       '工资发放表筛选视图ID
Private mlngSalarylistID As Long          '工资表ID
Private mstrReportName As String    '报表名称
Private mstrReportWhere As String   '报表条件
Private mstrReportSQL As String     '报表SQL
Private mblnIsOk As Boolean         '是否为完成退出
Private mblnIsSame As Boolean       '工资表ID是否发生改变

'调用工资发放表初始化
Public Function InitSalaryDevelopTable(ByRef clsSalary As clsSalaryRptSet, ByVal lngSalaryListID As Long) As Boolean
    Dim strName As String
    Dim STRSQL As String
    Me.Show vbModal
    clsSalary.SalaryDevelopName = mstrReportName
    clsSalary.SalaryDevelopWhere = mstrReportWhere
    clsSalary.SalaryDevelopID = mlngSalarylistID
    clsSalary.SalaryDevelopSQL = mstrReportSQL
    InitSalaryDevelopTable = mblnIsOk
    Unload Me
End Function
Private Sub cmdOK_Click()
    Dim lngArrID() As Long
    Dim intLevel As Integer
    Dim i As Integer
    Dim blnIsCode As Boolean
    Dim STRSQL As String
    
    '检查报表名称
    If Trim(txtReportName.Text) = "" Then
        SSTab1.Tab = 0
        ShowMsg Me.hwnd, "报表名称不能为空。", vbInformation, Me.Caption
        txtReportName.SetFocus
        Exit Sub
    End If
    '检查来源工资表
    If Trim(litSalarySource.Text) = "" Then
        SSTab1.Tab = 0
        ShowMsg Me.hwnd, "来源工资表不能为空。", vbInformation, Me.Caption
        Exit Sub
    End If
    '检查报表项目
    If msgSalaryItem(1).Rows <= 2 Then
        SSTab1.Tab = 1
        ShowMsg Me.hwnd, "至少应有一个数据项目。", vbInformation, Me.Caption
        Exit Sub
    End If
    '按部门打印的检查
    intLevel = 0
    If chkDepartMent.Value = 1 Then
        If Trim(cboDepartMent.Text) = "" Then
            SSTab1.Tab = 1
            ShowMsg Me.hwnd, "按部门打印必须选择一个部门级别.", vbInformation, Me.Caption
            Exit Sub
        Else
            intLevel = Val(Left(cboDepartMent.Text, 1))
        End If
        With msgSalaryItem(1)
            blnIsCode = False
            For i = 0 To .Rows - 1
                If .TextMatrix(i, 0) = "部门编号" Then
                    blnIsCode = True
                End If
            Next
        End With
        If blnIsCode = False Then
            SSTab1.Tab = 1
            ShowMsg Me.hwnd, "按部门打印报表项目中必须有部门编号.", vbInformation, Me.Caption
            Exit Sub
        End If
    End If
    '保存按部门打印设置
    If intLevel > 0 Then
        STRSQL = "Update  Setting Set  Setting.strSetting = " & intLevel & _
                 " Where Setting.lngModuleID=13 And Setting.strSection='工资发放表按部门打印' "
        gclsBase.ExecSQL STRSQL
    End If
    '保存报表项目
    SaveReportItem mlngSalarylistID
    '取得报表名称
    mstrReportName = Trim(txtReportName.Text)
    '取得筛选条件
    If mclsFilter Is Nothing Then
        mstrReportWhere = ""
    Else
        mstrReportWhere = mclsFilter.GetCond
        mstrReportWhere = ChangeWhere(mstrReportWhere)
    End If
    '组合查询项目条件的SQL语句
    mstrReportSQL = SetItemSQL()
    Unload Me
End Sub

'组合查询项目条件的SQL语句
Private Function SetItemSQL() As String
    Dim strSelect As String
    Dim i As Integer
    Dim strTmp As String
    Dim strFrom As String
    Dim strWhere As String
    
    strSelect = "SELECT "
    With msgSalaryItem(1)
        For i = 0 To .Rows - 1
            If .TextMatrix(i, 0) = "签名" Then
                'strTmp = .TextMatrix(i, 2) & " AS [" & .TextMatrix(i, 0) & "1], "
                strTmp = .TextMatrix(i, 2) & " AS """ & .TextMatrix(i, 0) & "1"", "
                strSelect = strSelect & strTmp
                'strTmp = .TextMatrix(i, 2) & " AS [" & .TextMatrix(i, 0) & "], "
                strTmp = .TextMatrix(i, 2) & " AS """ & .TextMatrix(i, 0) & """, "
                strSelect = strSelect & strTmp
            Else
                'strTmp = .TextMatrix(i, 2) & " AS [" & .TextMatrix(i, 0) & "], "
                strTmp = .TextMatrix(i, 2) & " AS """ & .TextMatrix(i, 0) & """, "
                strSelect = strSelect & strTmp
            End If
        Next
    End With
    strSelect = Trim(strSelect)
    strSelect = Left(strSelect, Len(strSelect) - 1)
    'strFrom = " FROM ((((((Employee INNER JOIN Salary ON Employee.lngEmployeeID = Salary.lngEmployeeID) " & _
              " INNER JOIN EmployeeType ON Employee.lngEmployeeTypeID = EmployeeType.lngEmployeeTypeID) " & _
              " LEFT JOIN Department ON Salary.lngDepartmentID = Department.lngDepartmentID) " & _
              " LEFT JOIN Education ON Employee.lngEducationID = Education.lngEducationID) " & _
              " LEFT JOIN PersonTaxType ON Employee.lngPersonTaxTypeID = PersonTaxType.lngPersonTaxTypeID) " & _
              " LEFT JOIN Title ON Employee.lngTitleID = Title.lngTitleID)  " & _
              " INNER JOIN SalaryList ON Salary.lngSalaryListID = SalaryList.lngSalaryListID "

    strFrom = " FROM Employee , Salary ,EmployeeType ,Department,Education,PersonTaxType,Title,SalaryList "

    strWhere = ""
    strWhere = mstrReportWhere
    SetItemSQL = strSelect & " " & strFrom
    'SetItemSQL = SetItemSQL & " WHERE Salary.lngSalaryListID= " & mlngSalarylistID
    SetItemSQL = SetItemSQL & " WHERE ((((((Employee.lngEmployeeID = Salary.lngEmployeeID) AND " & _
              " Employee.lngEmployeeTypeID = EmployeeType.lngEmployeeTypeID) AND " & _
              " Salary.lngDepartmentID = Department.lngDepartmentID(+)) AND " & _
              " Employee.lngEducationID = Education.lngEducationID(+))  AND " & _
              " Employee.lngPersonTaxTypeID = PersonTaxType.lngPersonTaxTypeID(+)) AND " & _
              " Employee.lngTitleID = Title.lngTitleID(+)) AND " & _
              " Salary.lngSalaryListID = SalaryList.lngSalaryListID AND " & _
              " Salary.lngSalaryListID= " & mlngSalarylistID
    
    If Trim(strWhere) <> "" Then
        SetItemSQL = SetItemSQL & " And " & strWhere
    End If
    SetItemSQL = SetItemSQL & " Order by Employee.strEmployeeCode "
End Function

Private Sub chkDepartMent_Click()
    If chkDepartMent.Value = 1 Then
        cboDepartMent.Enabled = True
    Else
        cboDepartMent.Enabled = False
    End If
End Sub

Private Sub cmdArr_Click(Index As Integer)
    Select Case Index
        Case 0   '取消
            mblnIsOk = False
            Unload Me
        Case 1   '上一步
            If SSTab1.Tab > 0 Then
                SSTab1.Tab = SSTab1.Tab - 1
            End If
        Case 2   '下一步
            If SSTab1.Tab < 2 Then
                SSTab1.Tab = SSTab1.Tab + 1
            End If
        Case 3   '完成
            mblnIsOk = True
            cmdOK_Click
    End Select
End Sub

Private Sub Form_Load()
    Dim STRSQL As String
    Dim strText As String
    Dim i As Integer
    'Dim recSalaryList As Recordset
    'Dim recDepartment As Recordset
    Dim recSalaryList As rdoResultset
    Dim recDepartment As rdoResultset
    Dim picRes As IPictureDisp
    Dim intLevel As Integer
    Dim strTmp As String
    
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.top = (Screen.Height - Me.Height) \ 2
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    SetHelpID Me.hwnd, 10234
    '初始化报表名称
    txtReportName.Text = "工资发放表"
    '初始化图片资源
    Set picRes = Utility.GetFormResPicture(1019, vbResBitmap)
    cmdUpDown(0).Picture = picRes
    Set picRes = Utility.GetFormResPicture(1020, vbResBitmap)
    cmdUpDown(1).Picture = picRes
    imgSalarySet(0).Picture = Utility.GetFormResPicture(140, 0)
    imgSalarySet(1).Picture = Utility.GetFormResPicture(140, 0)
    
    SSTab1.Tab = 0
    ''设置命令按钮是否可用
    InitCmdarrState
    '初始化来源工资表
    STRSQL = "SELECT SalaryList.lngSalaryListID, SalaryList.strSalaryListName FROM SalaryList " & _
             " ORDER BY  SalaryList.strDate DESC"
    'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenSnapshot)
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(STRSQL, rdOpenStatic)
    If Not recSalaryList.EOF Then
        litSalarySource.SeekCol = "-1,2"
        Set litSalarySource.Recordset = recSalaryList
        litSalarySource.ColWidth(1) = 0
    End If
    recSalaryList.Close
    Set recSalaryList = Nothing
    If mlngSalarylistID > 0 Then
        STRSQL = "SELECT SalaryList.lngSalaryListID, SalaryList.strSalaryListName FROM SalaryList WHERE SalaryList.lngSalaryListID= " & mlngSalarylistID
        'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenSnapshot)
        Set recSalaryList = gclsBase.BaseDB.OpenResultset(STRSQL, rdOpenStatic)
        If Not recSalaryList.EOF Then
            litSalarySource.Text = recSalaryList!strSalaryListName
        End If
        recSalaryList.Close
        Set recSalaryList = Nothing
    End If
    '初始化打印
    chkDepartMent.Value = 0
    STRSQL = "SELECT max(Department.intLevel) as MaXLevel FROM Department "
    'Set recDepartment = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenSnapshot)
    Set recDepartment = gclsBase.BaseDB.OpenResultset(STRSQL, rdOpenStatic)
    With recDepartment
        If Not .EOF Then
            chkDepartMent.Enabled = True
            intLevel = IIf(IsNull(!MaXLevel), 0, !MaXLevel)
            For i = 1 To intLevel
                strTmp = i & "  级 "
                cboDepartMent.AddItem strTmp
            Next
            cboDepartMent.Enabled = False
        Else
            chkDepartMent.Enabled = False
            cboDepartMent.Enabled = False
        End If
    End With
    recDepartment.Close
    Set recDepartment = Nothing
    mblnIsOk = False
    mblnIsSame = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (140)
    Utility.RemoveFormResPicture (1019)
    Utility.RemoveFormResPicture (1020)
    gclsSys.MainControls.Remove Me               '
    Set mclsMainControl = Nothing                '清除主控对象
    Set mclsFilter = Nothing
    Set frmSalaryDevelopWizard = Nothing
End Sub

'设置命令按钮是否可用(上一步,下一步)
Private Sub InitCmdarrState()
    If SSTab1.Tab = 0 Then
        cmdArr(1).Enabled = False
        cmdArr(2).Enabled = True
        CmdReset.Visible = False
    End If
    If SSTab1.Tab = 2 Then
        cmdArr(2).Enabled = False
        cmdArr(1).Enabled = True
        CmdReset.Visible = True
    End If
    If SSTab1.Tab = 1 Then
        cmdArr(1).Enabled = True
        cmdArr(2).Enabled = True
        CmdReset.Visible = False
    End If
    If SSTab1.Tab = 0 Then
        cmdArr(3).Enabled = False
    Else
        cmdArr(3).Enabled = True
    End If
End Sub

Private Sub litSalarySource_Choose()
    If litSalarySource.ReferRow > -1 Then
        mlngSalarylistID = litSalarySource.TextMatrix(litSalarySource.ReferRow, 1)
        mblnIsSame = True
    End If
End Sub

Private Sub msgSalaryItem_Click(Index As Integer)
    If Index = 1 Then
        InitcmdUpDowntate
    End If
End Sub

Private Sub msgSalaryItem_DblClick(Index As Integer)
    If Index = 0 Then