frmsalaryemployee.frm

金算盘软件代码

                        End If
                        intCount1 = intCount1 + 1
                        If intCount1 = 100 Then
                            If Trim(strInWhere) <> "" Then   '增加
                                strInWhere = Trim(strInWhere)
                                strSql = "INSERT INTO Salary ( lngEmployeeID,lngDepartmentID,lngEmployeeTypeID, " _
                                    & "blnIsPersonTax,lngPersonTaxTypeID,lngBankID,strBankCode,lngSalaryListID) " _
                                    & " SELECT lngEmployeeID,lngDepartmentID, " _
                                    & "lngEmployeeTypeID,blnIsPersonTax,lngPersonTaxTypeID,lngBankID,strBankCode, " _
                                    & mlngSalaryID & " AS lngSalaryListID FROM Employee WHERE " _
                                    & "lngEmployeeID IN" & strInWhere & ")"
                                gclsBase.BaseDB.Execute strSql
                                '改变工资扣税标准（一月只有一个扣税标准即个人所得税类别ID）
                                Salary.Update_lngPersonTaxTypeID mlngSalaryID
                                '为增加的职员计算工龄
                                strZ = "UPDATE SalaryData Set Sa18660 =0 Where lngSalaryListID=" & mlngSalaryID & _
                                       " AND lngEmployeeID IN " & strInWhere & ")"
                                gclsBase.BaseDB.Execute (strZ)
                                strZ = "SELECT SalaryList.lngSalaryListID, SalaryList.strSalaryAgeFormula, " & _
                                       " SalaryList.strSalaryAgeMethod FROM SalaryList " & _
                                       " WHERE SalaryList.lngSalaryListID = " & mlngSalaryID
                                Set recZ = gclsBase.BaseDB.OpenResultset(strZ, rdOpenStatic)
                                If Not recZ.EOF Then
                                    strAgeMethod = Trim(recZ!strSalaryAgeMethod)
                                    strAgeFormula = Trim(recZ!strSalaryAgeFormula)
                                    If strAgeMethod <> "0" Then
                                        'Strsql = "UPDATE SalaryData Set Sa18660 = IIF(ISNULL(" & strAgeFormula & _
                                                 "),0," & strAgeFormula & ") Where lngSalaryListID=" & mlngSalaryID & _
                                                 " AND Trim(strDate) <> '' AND Trim(strInDate) <> ''" & _
                                                 " AND lngEmployeeID IN " & strInWhere & ")"
                                        strSql = "UPDATE SalaryData Set Sa18660 = NVL(" & strAgeFormula & _
                                                 ",0 )  Where lngSalaryListID=" & mlngSalaryID & _
                                                 " AND (LTrim(RTRIM(strDate)) IS NOT NULL) AND( LTrim(RTRIM(strInDate)) IS NOT NULL )" & _
                                                 " AND lngEmployeeID IN " & strInWhere & ")"
                                        gclsBase.BaseDB.Execute strSql
                                    End If
                                End If
                                recZ.Close
                                Set recZ = Nothing
                            End If
                            intCount1 = 0
                            strInWhere = ""
                        End If
                    End If
                Else                         '删除
                    If Trim(.TextMatrix(i, 2)) = "" Then
                        If Trim(strDelSql) = "" Then
                            strDelSql = "(" & .TextMatrix(i, 0)
                            strName = .TextMatrix(i, 4)
                        Else
                            strDelSql = strDelSql & "," & .TextMatrix(i, 0)
                        End If
                        intCount2 = intCount2 + 1
                        If intCount2 = 100 Then
                            If Trim(strDelSql) <> "" Then  '删除
                                If intSum > 0 Then
                                    strDelSql = "DELETE FROM Salary WHERE lngSalaryListID=" & mlngSalaryID & _
                                        " AND lngEmployeeID IN" & strDelSql & ")"
                                    gclsBase.BaseDB.Execute strDelSql
                                Else
                                    intMsg = ShowMsg(Me.hwnd, "取消职员" & strName & "等的工资", vbOKCancel + vbQuestion _
                                        + vbDefaultButton2, "工资发放")
                                    If intMsg = vbOK Then
                                        strDelSql = "DELETE FROM Salary WHERE lngSalaryListID=" & mlngSalaryID & _
                                            " AND lngEmployeeID IN" & strDelSql & ")"
                                        gclsBase.BaseDB.Execute strDelSql
                                        intCount2 = 0
                                        strDelSql = ""
                                    Else
                                        Exit Sub
                                    End If
                                End If
                            End If
                            intSum = intSum + 1
                        End If
                    End If
                End If
            Next i
        End With
        If Trim(strDelSql) <> "" Then  '删除
            If intSum > 0 Then
                strDelSql = "DELETE FROM Salary WHERE lngSalaryListID=" & mlngSalaryID & _
                    " AND lngEmployeeID IN" & strDelSql & ")"
                gclsBase.BaseDB.Execute strDelSql
            Else
                intMsg = ShowMsg(Me.hwnd, "取消职员" & strName & "等的工资", vbOKCancel + vbQuestion _
                    + vbDefaultButton2, "工资发放")
                If intMsg = 1 Then
                    strDelSql = "DELETE FROM Salary WHERE lngSalaryListID=" & mlngSalaryID & _
                        " AND lngEmployeeID IN" & strDelSql & ")"
                    gclsBase.BaseDB.Execute strDelSql
                Else
                    Exit Sub
                End If
            End If
        End If
        If Trim(strInWhere) <> "" Then    '增加
            strInWhere = Trim(strInWhere)
            strSql = "INSERT INTO Salary ( lngEmployeeID,lngDepartmentID,lngEmployeeTypeID, " _
                & "blnIsPersonTax,lngPersonTaxTypeID,lngBankID,strBankCode,lngSalaryListID) " _
                & " SELECT lngEmployeeID,lngDepartmentID, " _
                & "lngEmployeeTypeID,blnIsPersonTax,lngPersonTaxTypeID,lngBankID,strBankCode, " _
                & mlngSalaryID & " AS lngSalaryListID FROM Employee WHERE " _
                & "lngEmployeeID IN" & strInWhere & ")"
            gclsBase.BaseDB.Execute strSql
            '改变工资扣税标准（一月只有一个扣税标准即个人所得税类别ID）
            Salary.Update_lngPersonTaxTypeID mlngSalaryID
            '为增加的职员计算工龄
            strZ = "UPDATE SalaryData Set Sa18660 =0 Where lngSalaryListID=" & mlngSalaryID & _
                   " AND lngEmployeeID IN " & strInWhere & ")"
            gclsBase.BaseDB.Execute (strZ)
            strZ = "SELECT SalaryList.lngSalaryListID, SalaryList.strSalaryAgeFormula, " & _
                   " SalaryList.strSalaryAgeMethod FROM SalaryList " & _
                   " WHERE SalaryList.lngSalaryListID = " & mlngSalaryID
            Set recZ = gclsBase.BaseDB.OpenResultset(strZ, rdOpenStatic)
            If Not recZ.EOF Then
                strAgeMethod = Trim(recZ!strSalaryAgeMethod)
                strAgeFormula = Trim(recZ!strSalaryAgeFormula)
                If strAgeMethod <> "0" Then
                    'Strsql = "UPDATE SalaryData Set Sa18660 = IIF(ISNULL(" & strAgeFormula & _
                             "),0," & strAgeFormula & ") Where lngSalaryListID=" & mlngSalaryID & _
                             " AND Trim(strDate) <> '' AND Trim(strInDate) <> ''" & _
                             " AND lngEmployeeID IN " & strInWhere & ")"
                    strSql = "UPDATE SalaryData Set Sa18660 = NVL(" & strAgeFormula & _
                             ",0 )  Where lngSalaryListID=" & mlngSalaryID & _
                             " AND (LTrim(RTRIM(strDate)) IS NOT NULL) AND( LTrim(RTRIM(strInDate)) IS NOT NULL )" & _
                             " AND lngEmployeeID IN " & strInWhere & ")"
                    gclsBase.BaseDB.Execute strSql
                End If
            End If
            recZ.Close
            Set recZ = Nothing
        End If
        Unload Me
    Case 1    '取消
        mblnIsOK = False
        Unload Me
    Case 2   '全选
        i = 1
        With msgSalary
            Do While i < .Rows
                .TextMatrix(i, 2) = "√"
                i = i + 1
            Loop
        End With
    Case 3   '条件选择
        Call Select_Some
    Case 4   '全部取消
        i = 1
        With msgSalary
            Do While i < .Rows
                .TextMatrix(i, 2) = ""
                i = i + 1
            Loop
        End With
    End Select
End Sub

Private Sub cmdFind_Click()
    Dim i As Long
    Dim strFindText As String
    Dim lngOldRow As Long
    If cboFind.ListIndex > -1 Then
        With msgSalary
            i = .Row
            lngOldRow = .Row
            '查找行
            If txtFindValue.SelLength > 0 Then
                strFindText = Left(txtFindValue.Text, txtFindValue.SelLength - 1)
            Else
                strFindText = txtFindValue.Text
            End If
            If InStr(strFindText, mstrFindText) = 1 Then
                strFindText = mstrFindText
            End If
            Do While i < .Rows - 1
                i = i + 1
                If InStr(Trim(.TextMatrix(i, mlngFindCol)), strFindText) = 1 Then
                    .Row = i
                    .col = 0
                    .ColSel = .Cols - 1
                    If Not .RowIsVisible(.Row) Then     '当前行为不可见则让其可见
                        If .Row < .TopRow Then
                            .TopRow = IIf(.Row - 3 < 1, 1, .Row - 3)
                        Else
                            .TopRow = .Row
                        End If
                    End If
                    Exit Do
                End If
            Loop
            txtFindValue.SelStart = Len(strFindText)
            txtFindValue.SelLength = Len(txtFindValue.Text) - Len(strFindText)
            mstrFindText = strFindText
            On Error Resume Next
            txtFindValue.SetFocus
            '不能再找
            If .Row = lngOldRow Then
                CmdFind.Enabled = False
            Else
                CmdFind.Enabled = True
            End If
        End With
    End If
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    Me.Left = (Screen.width - Me.width) / 2
    Me.top = (Screen.Height - Me.Height) / 2
    Set msgSalary.MouseIcon = Utility.GetFormResPicture(2001, 2)
    Set cmdAddItem(0).Picture = Utility.GetFormResPicture(1001, 0)
    Set cmdAddItem(1).Picture = Utility.GetFormResPicture(1002, 0)
    Set CmdFind.Picture = Utility.GetFormResPicture(1017, 0)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    'SetHelpID Me.hwnd, 10232
    mlngSalaryID = frmSalaryList.SalaryID
    Set mclsGrid1 = New Grid
    Set mclsGrid1.Grid = msgSalary
'    SetEmployeeArea
'    mlngFindCol = 2
'    cboFind.Text = "职员编号"
'    mblnIsOk = False
End Sub
Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        If Me.width < 5200 Then
            Me.width = 5200
        End If
        If Me.Height < 3000 Then
            Me.Height = 3000
        End If
        msgSalary.width = Me.width - cmdAddItem(0).width - 320
        msgSalary.Height = Me.Height - 855
        cmdAddItem(0).Left = Me.width - cmdAddItem(0).width - 180
        cmdAddItem(1).Left = cmdAddItem(0).Left
        cmdAddItem(2).Left = cmdAddItem(0).Left
        cmdAddItem(3).Left = cmdAddItem(0).Left
        cmdAddItem(4).Left = cmdAddItem(0).Left
        txtFindValue.width = Me.width - 4710
        CmdFind.Left = msgSalary.Left + msgSalary.width - CmdFind.width
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1017)
    Utility.RemoveFormResPicture (2001)
    Utility.RemoveFormResPicture (139)
    Set frmSalaryEmployee = Nothing
End Sub

Private Sub mclsGrid1_AfterColChange(lngSourCol As Long, lngDestCol As Long)
    '搜索查找列
    Call cboFind_Click
End Sub

Private Sub msgSalary_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 32 Then
        With msgSalary
            If .Rows > 1 Then
                If .TextMatrix(.Row, 2) = "" Then
                    .TextMatrix(.Row, 2) = "√"
                Else
                    .TextMatrix(.Row, 2) = ""
                End If
                .RowSel = .Row
            End If
        End With
    End If
End Sub

Private Sub msgSalary_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgSalary
        If x < .ColWidth(2) And y < .Rows * .RowHeight(0) And y > .RowHeight(0) Then
            .MousePointer = vbCustom
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub
Private Sub msgSalary_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim intCount As Long
    Dim intTmp As Integer
    
    With msgSalary
        If .ColSel = 0 Then
            mblnChangeText = True
            txtFindValue.Text = ""
            mblnChangeText = False