frmsalaryemployee.frm

金算盘软件代码

            CmdFind.Enabled = False
        Else
            If .Rows > 1 Then
                CmdFind.Enabled = True
                txtFindValue.Text = .TextMatrix(.Row, mlngFindCol)
            End If
        End If
        If x < .ColWidth(2) And y < .Rows * .RowHeight(0) And y > .RowHeight(0) Then
            If .TextMatrix(.Row, 2) = "" Then
                .TextMatrix(.Row, 2) = "√"
            Else
                .TextMatrix(.Row, 2) = ""
            End If
            .RowSel = .Row
        End If
        If Button = vbLeftButton Then
            If y > .RowPos(0) And y < .RowPos(0) + .RowHeight(0) Then       '排序
                For intCount = 3 To .Cols - 1
                    If x > .ColPos(intCount) And x < .ColPos(intCount) + .ColWidth(intCount) And y > .RowPos(0) And y < .RowPos(0) + .RowHeight(0) Then
                        mclsGrid1.ColSort(intCount) = True
                        intTmp = mclsGrid1.SortedType
                        If intTmp <> 1 Then
                            mclsGrid1.Sort intCount, 2   '降序
                        Else
                            mclsGrid1.Sort intCount, 1   '升序
                        End If
                    End If
                Next
            End If
        End If
    End With
End Sub
Private Sub Select_Some()
    Dim strSelect As String
    Dim strFrom As String
    Dim strWhere As String
    Dim strSql As String
    Dim i As Long
    Dim recEmployee As rdoResultset
    Dim recList As rdoResultset
    Dim lngListID As Long
    Dim lngSalaryListID As Long
    Dim blnOK As Boolean
    Dim intVersion As Integer
    Dim strTmp As String
    Dim strTmpsql As String
    Dim lngTmpID As Long
    Dim lngRecCount As Long
    Dim strAllID As String
    Dim strFilterWhere As String
    
    mclsGrid1.ListSet.SaveList
    '根据工资表视图整理职员范围表视图
    Salary.InitFilterView72 mlngSalaryID
    lngListID = mclsGrid1.ListSet.ListID
    Filter.DelSelectedCond lngListID, 1
    Filter.ShowFilter lngListID, 1, , , , , blnOK, , "条件选择"
    If Not blnOK Then
        Exit Sub
    End If
    mclsGrid1.ListSet.SaveList
    mclsGrid1.ListSet.ViewId = 72
    strFilterWhere = Filter.GetInitWhere(lngListID, 1)
    With mclsGrid1.ListSet
        strSelect = "Select Employee.lngEmployeeID As ID "
        strFrom = .FromOfSql
        strWhere = .WhereOfSql
    End With
    strSql = strSelect & " " & strFrom
    lngSalaryListID = frmSalaryList.SalaryID
    'Strsql = Strsql & " WHERE Employee.lngEmployeeID NOT IN(SELECT " & _
            " lngEmployeeID FROM Salary WHERE lngSalaryListID=" & lngSalaryListID & ")"
    If strWhere <> "" Then
        strSql = strSql & " WHERE " & strWhere
        strSql = strSql & " AND NOT Exists(SELECT " & _
            " lngEmployeeID FROM Salary WHERE Employee.lngEmployeeID=Salary.lngEmployeeID " _
            & " And lngSalaryListID=" & lngSalaryListID & ")"
    Else
        strSql = strSql & " Where NOT Exists(SELECT " & _
            " lngEmployeeID FROM Salary WHERE Employee.lngEmployeeID=Salary.lngEmployeeID " _
            & " And lngSalaryListID=" & lngSalaryListID & ")"
    End If
    strTmpsql = strSql
    'Strsql = Strsql & " UNION " & _
            " SELECT Employee.lngEmployeeID AS ID " & _
            " FROM (((Salary INNER JOIN ((Employee LEFT JOIN Title ON Employee.lngTitleID = Title.lngTitleID) " & _
            " LEFT JOIN Education ON Employee.lngEducationID = Education.lngEducationID) ON  " & _
            " Salary.lngEmployeeID = Employee.lngEmployeeID) " & _
            " LEFT JOIN Department ON Salary.lngDepartmentID = Department.lngDepartmentID)" & _
            " LEFT JOIN EmployeeType ON Salary.lngEmployeeTypeID = EmployeeType.lngEmployeeTypeID) " & _
            " LEFT JOIN PersonTaxType ON Salary.lngPersonTaxTypeID = PersonTaxType.lngPersonTaxTypeID " & _
            " WHERE (Salary.lngSalaryListID = " & lngSalaryListID & " ) "
    strSql = strSql & " UNION " & _
            " SELECT Employee.lngEmployeeID AS ID " & _
            " FROM Salary,Employee,Title,Education,Department,EmployeeType,PersonTaxType " & _
                " WHERE ((((( Employee.lngTitleID = Title.lngTitleID(+)) " & _
                " AND Employee.lngEducationID = Education.lngEducationID(+)) " & _
                " AND Salary.lngEmployeeID = Employee.lngEmployeeID) " & _
                " AND Salary.lngDepartmentID = Department.lngDepartmentID(+))" & _
                " AND Salary.lngEmployeeTypeID = EmployeeType.lngEmployeeTypeID(+)) " & _
                " AND Salary.lngPersonTaxTypeID = PersonTaxType.lngPersonTaxTypeID(+) " & _
                " AND (Salary.lngSalaryListID = " & lngSalaryListID & " )"
    If strFilterWhere <> "" Then
        strFilterWhere = Salary.Change_Text("Employee.lngEmployeeID", "Salary.lngEmployeeID", strFilterWhere, True)
        strFilterWhere = Salary.Change_Text("Employee.lngEmployeeTypeID", "Salary.lngEmployeeTypeID", strFilterWhere, True)
        strFilterWhere = Salary.Change_Text("Department.lngDepartmentID", "Salary.lngDepartmentID", strFilterWhere, True)
        strSql = strSql & " And " & strFilterWhere
    End If
    Set recEmployee = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recEmployee.EOF Then
        recEmployee.MoveLast
        recEmployee.MoveFirst
        With msgSalary
            For i = 1 To .Rows - 1
                .TextMatrix(i, 2) = ""
            Next
        End With
        strAllID = ","
        For i = 0 To recEmployee.RowCount - 1
            strAllID = strAllID & recEmployee!ID & ","
            recEmployee.MoveNext
        Next
        With msgSalary
            For i = 1 To .Rows - 1
                If InStr(strAllID, "," & Trim(.TextMatrix(i, 0)) & ",") > 0 Then
                    .TextMatrix(i, 2) = "√"
                End If
            Next
        End With
    Else
        With msgSalary
            For i = 1 To .Rows - 1
                .TextMatrix(i, 2) = ""
            Next
        End With
    End If
    recEmployee.Close
    Set recEmployee = Nothing
End Sub
Private Sub msgSalary_RowColChange()
    With msgSalary
        txtFindValue.Text = .TextMatrix(.Row, mlngFindCol)
        If Not .RowIsVisible(.Row) Then     '当前行为不可见则让其可见
            If .Row < .TopRow Then
                .TopRow = IIf(.Row - 3 < 1, 1, .Row - 3)
            Else
                .TopRow = .Row
            End If
        End If
    End With
End Sub

Private Sub txtFindValue_Change()
    Dim strText As String
    Dim lngStart As Long
    Dim i As Long
    If mblnChangeText = True Then
        Exit Sub
    End If
    With msgSalary
        If .Row > 0 And .col < .Cols Then
            mblnChangeText = True
            strText = Trim(txtFindValue.Text)
            If mblnKeyPress Then
                mblnKeyPress = False
                i = 1
            Else
                i = .Row
            End If
            Do While i < .Rows
                If InStr(Trim(.TextMatrix(i, mlngFindCol)), Trim(txtFindValue.Text)) = 1 Then
                    .Row = i
                    .col = 0
                    .ColSel = .Cols - 1
                    txtFindValue.Text = .TextMatrix(i, mlngFindCol)
                    Exit Do
                End If
                i = i + 1
            Loop
            If i = .Rows Then
                CmdFind.Enabled = False
            Else
                CmdFind.Enabled = True
            End If
            lngStart = Len(strText)
            txtFindValue.SelStart = Len(strText)
            mstrFindText = strText
            txtFindValue.SelLength = Len(txtFindValue.Text) - lngStart
            mblnChangeText = False
        End If
    End With
End Sub
Private Sub txtFindValue_KeyPress(KeyAscii As Integer)
    mblnKeyPress = True
End Sub
Public Function ShowSalaryEmployee() As Boolean
    Load Me
    SetEmployeeArea
    mlngFindCol = 2
    cboFind.Text = "职员编号"
    mblnIsOK = False
    frmSalaryEmployee.Show vbModal
    ShowSalaryEmployee = mblnIsOK
End Function

Private Sub SetEmployeeArea()
    Dim recEmployee As rdoResultset
    Dim strSql As String
    Dim strSelect As String
    Dim strFrom  As String
    Dim strWhere As String
    
    mclsGrid1.ColOfs = 3
    mclsGrid1.ListSet.ViewId = 72
    Filter.DelSelectedCond mclsGrid1.ListSet.ListID, 1
    With msgSalary
        .Redraw = False
        .FixedCols = 0
    End With
    With mclsGrid1.ListSet
        strSelect = "Select Employee.lngEmployeeID As ID,0 AS intSourceTable ,' ' As 选择," & .SelectOfSql
        strFrom = .FromOfSql
        strWhere = .WhereOfSql
    End With
    strSql = strSelect & " " & strFrom & " WHERE " & strWhere
'    strSql = strSql & " AND Employee.lngEmployeeID NOT IN(SELECT " & _
            " lngEmployeeID FROM Salary WHERE lngSalaryListID=" & mlngSalaryID & ")"
    strSql = strSql & " AND NOT Exists(SELECT " & _
            " lngEmployeeID FROM Salary WHERE Employee.lngEmployeeID=Salary.lngEmployeeID " _
            & " And lngSalaryListID=" & mlngSalaryID & ")"
    'Strsql = Strsql & " UNION " & _
            " SELECT Employee.lngEmployeeID AS ID, '√' AS 选择, Employee.strEmployeeCode AS 职员编号," & _
            " Employee.strEmployeeName AS 职员姓名, EmployeeType.strEmployeeTypeName AS 职员类别," & _
            " Department.strDepartmentName AS 所属部门, Title.strTitleName AS 职务," & _
            " IIf(Employee.blnIsMale=True,'男','女') AS 性别, Education.strEducationName AS 文化程度 " & _
            " FROM (((Salary INNER JOIN ((Employee LEFT JOIN Title ON Employee.lngTitleID = Title.lngTitleID) " & _
            " LEFT JOIN Education ON Employee.lngEducationID = Education.lngEducationID) ON  " & _
            " Salary.lngEmployeeID = Employee.lngEmployeeID) " & _
            " LEFT JOIN Department ON Salary.lngDepartmentID = Department.lngDepartmentID)" & _
            " LEFT JOIN EmployeeType ON Salary.lngEmployeeTypeID = EmployeeType.lngEmployeeTypeID) " & _
            " LEFT JOIN PersonTaxType ON Salary.lngPersonTaxTypeID = PersonTaxType.lngPersonTaxTypeID " & _
            " WHERE (Salary.lngSalaryListID = " & mlngSalaryID & " ) AND ( " & _
            " Employee.lngEmployeeID IN (SELECT lngEmployeeID FROM Salary WHERE lngSalaryListID = " & mlngSalaryID & "))"
    strSql = strSql & " UNION " & _
            " SELECT Employee.lngEmployeeID AS ID,1 AS intSourceTable, '√' AS 选择, Employee.strEmployeeCode AS 职员编号," & _
            " Employee.strEmployeeName AS 职员姓名, EmployeeType.strEmployeeTypeName AS 职员类别," & _
            " Department.strDepartmentName AS 所属部门, Title.strTitleName AS 职务," & _
            " DECODE(Employee.blnIsMale,1,'男','女') AS 性别, Education.strEducationName AS 文化程度 " & _
            " FROM Salary,Employee,Title,Education,Department,EmployeeType,PersonTaxType " & _
            " WHERE (((((Employee.lngTitleID = Title.lngTitleID(+)) " & _
            " AND Employee.lngEducationID = Education.lngEducationID(+)) " & _
            " AND Salary.lngEmployeeID = Employee.lngEmployeeID) " & _
            " AND Salary.lngDepartmentID = Department.lngDepartmentID(+)) " & _
            " AND Salary.lngEmployeeTypeID = EmployeeType.lngEmployeeTypeID(+)) " & _
            " AND Salary.lngPersonTaxTypeID = PersonTaxType.lngPersonTaxTypeID(+) " & _
            " AND (Salary.lngSalaryListID = " & mlngSalaryID & " )  "
    Set recEmployee = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    '列表是否为空
    If recEmployee.EOF Then
        msgSalary.HighLight = flexHighlightNever
    Else
        msgSalary.HighLight = flexHighlightAlways
    End If
    Set datEmployee.Resultset = recEmployee
    recEmployee.Close
    Set recEmployee = Nothing
    With msgSalary
        .SelectionMode = flexSelectionByRow
        .FocusRect = flexFocusNone
    End With
    mclsGrid1.ListSetToGrid
    mclsGrid1.SetupStyle
    With msgSalary
        .ColWidth(0) = 0
        .ColWidth(1) = 0
        .ColWidth(2) = 440
        .ColWidth(3) = 1000
        .ColWidth(4) = 1000
        .ColWidth(5) = 2000
        .ColWidth(6) = 2000
        .ColWidth(7) = 800
        .ColWidth(8) = 800
        .ColWidth(9) = 1000
        .Redraw = True
    End With
    mclsGrid1.ColSort(3) = True      '设置列表排序列
    mclsGrid1.Sort 3, 1
End Sub