frmsalarylist.frm

金算盘软件代码

End Property

Public Property Get IsAddSalary() As Boolean
    IsAddSalary = mblnIsAddSalary
End Property
Public Property Get Salary_SQL() As Variant
    Salary_SQL = mstrSalarySQL
End Property
Private Sub msgSalaryList_RowColChange()
    With msgSalaryList
        txtFindValue.Text = .TextMatrix(.Row, mlngFindCol)
    End With
End Sub
Public Property Get SalaryInput() As Boolean
    SalaryInput = mblnSalaryInput
End Property
Public Property Let SalaryInput(ByVal blnInput As Boolean)
    mblnSalaryInput = blnInput
End Property

'工资目录表筛选条件
Public Property Get SalaryFilterWhere() As String
    SalaryFilterWhere = mstrWhereOFSQL
End Property
Public Sub ResponseMessage()
    
End Sub
Public Property Get SalaryName() As String
    Dim i As Integer
    i = 1
    SalaryName = ""
    With msgSalaryList
        Do While i < .Rows
            If .TextMatrix(i, 0) = mlngSalaryID Then
                SalaryName = .TextMatrix(i, 1)
                Exit Do
            End If
            i = i + 1
        Loop
    End With
End Property
Public Property Let MonneyOK(ByVal blnIsOK As Boolean)
    mblnMonneyOK = blnIsOK
End Property
Public Property Get MonneyOK() As Boolean
    MonneyOK = mblnMonneyOK
End Property
Private Sub Print_Grid()
    Dim clsPrint As PrintClass
    Dim intSortCol As Integer
    Dim intSortType As Integer
    Dim i As Integer
    
    intSortCol = 0
    intSortType = 0
    With msgSalaryList
        For i = 0 To .Cols - 1
            .ColAlignment(i) = 1
            If Right(Trim(.TextMatrix(0, i)), 1) = "↑" Then
                intSortCol = i
                intSortType = 1
                .TextMatrix(0, i) = Left(Trim(.TextMatrix(0, i)), Len(Trim(.TextMatrix(0, i))) - 1)
            ElseIf Right(Trim(.TextMatrix(0, i)), 1) = "↓" Then
                intSortCol = i
                intSortType = -1
                .TextMatrix(0, i) = Left(Trim(.TextMatrix(0, i)), Len(Trim(.TextMatrix(0, i))) - 1)
            End If
        Next
    End With
    Set clsPrint = New PrintClass
    clsPrint.PrintList gclsBase.BaseDB, msgSalaryList, 52, "工资目录" & Chr(1) _
        & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    With msgSalaryList
        If intSortCol > 0 Then
            If intSortType = 1 Then
               .TextMatrix(0, intSortCol) = .TextMatrix(0, intSortCol) & "↑"
            ElseIf intSortType = -1 Then
                .TextMatrix(0, intSortCol) = .TextMatrix(0, intSortCol) & "↓"
            Else
                .TextMatrix(0, intSortCol) = .TextMatrix(0, intSortCol) & "↑"
            End If
        End If
    End With
End Sub
Private Sub PrintSetup_Grid()
    Dim clsPrint As PrintClass
    Set clsPrint = New PrintClass
    clsPrint.PrintSetUp gclsBase.BaseDB, msgSalaryList, , , , 52, " "
End Sub
Public Sub RefreshMenu()
    On Error Resume Next
    With frmMain
        .mnuListEditMenu(0).Enabled = True
        .mnuEditEdit.Enabled = True
        .mnuListEditMenu(1).Enabled = True
        .mnuEditNew.Enabled = True
        .mnuListEditMenu(2).Enabled = True
        .mnuEditDel.Enabled = True
        .mnuListEditMenu(4).Enabled = True
        .mnuListEditMenu(5).Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(1).Enabled = True
        .mnuListReportMenu(2).Enabled = True
        .mnuListReportMenu(3).Enabled = True
        .mnuListReportMenu(4).Enabled = True
        .mnuListReportMenu(5).Enabled = True
        .mnuListEditMenu(7).Enabled = True
        .mnuToolRefresh.Enabled = True
        .mnuListEditMenu(8).Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        If msgSalaryList.Rows = 1 Then
            .mnuFilePrint.Enabled = False
            .mnuListEditMenu(8).Enabled = False
        End If
        With msgSalaryList
            If .Rows > 1 And Val(.TextMatrix(.Row, 1)) = 1 Then
                frmMain.mnuListReportMenu(5).Enabled = True
            Else
                frmMain.mnuListReportMenu(5).Enabled = False
            End If
        End With
        If msgSalaryList.Rows = 1 Or msgSalaryList.ColSel = 0 Then
            .mnuListEditMenu(0).Enabled = False
            .mnuEditEdit.Enabled = False
            .mnuListEditMenu(2).Enabled = False
            .mnuEditDel.Enabled = False
            .mnuListEditMenu(4).Enabled = False
            .mnuListReportMenu(0).Enabled = False
            .mnuListReportMenu(1).Enabled = False
            .mnuListReportMenu(2).Enabled = False
            .mnuListReportMenu(3).Enabled = False
           ' .mnuListReportMenu(4).Enabled = False
            .mnuListReportMenu(4).Enabled = False
            .mnuListReportMenu(5).Enabled = False
        End If
    End With
    '有录入窗体存在不允许对工资表的增删改
    If mblnSalaryInput = True Then
        With frmMain
            .mnuListEditMenu(0).Enabled = False
            .mnuEditEdit.Enabled = False
            .mnuListEditMenu(1).Enabled = False
            .mnuEditNew.Enabled = False
            .mnuListEditMenu(2).Enabled = False
            .mnuEditDel.Enabled = False
        End With
    End If
    '已结帐的工资表不允许修改和删除
    If Me.IsPostDate = True Then
        With frmMain
            .mnuListEditMenu(0).Enabled = False
            .mnuEditEdit.Enabled = False
            .mnuListEditMenu(2).Enabled = False
            .mnuEditDel.Enabled = False
        End With
    End If
    '据操作员权限对菜单作相应的变动
    SetOpertarRight
    '没有工资设置权限
    If Not mblnIsSetRight Then
        With frmMain
            .mnuListEditMenu(0).Enabled = False
            .mnuEditEdit.Enabled = False
            .mnuListEditMenu(1).Enabled = False
            .mnuEditNew.Enabled = False
            .mnuListEditMenu(2).Enabled = False
            .mnuEditDel.Enabled = False
        End With
    End If
    '没有工资录入权限
    If Not mblnIsInputRight Then
        With frmMain
            .mnuListEditMenu(4).Enabled = False
        End With
    End If
    frmMain.SetToolBar
End Sub
Private Sub txtFindValue_Change()
    Dim strText As String
    Dim lngStart As Long
    Dim i As Integer
    If mblnChangeText = True Then
        Exit Sub
    End If
    With msgSalaryList
        If .Row > 0 And .col < 5 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 = 5
                    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
'当前工资表是否已经结帐
Public Property Get IsPostDate() As Boolean
    Dim i As Integer
    With msgSalaryList
        On Error Resume Next
        If .TextMatrix(0, 1) = "" Then
             Call JionGrid
        End If
        For i = 1 To .Cols - 1
            If InStr(Trim(.TextMatrix(0, i)), "结帐日期") = 1 Then
                Exit For
            End If
        Next i
        If IsNull(.TextMatrix(.Row, i)) Then
            IsPostDate = False
        Else
            If Trim(.TextMatrix(.Row, i)) = "" Then
                IsPostDate = False
            Else
                If IsDate(Trim(.TextMatrix(.Row, i))) Then
                    IsPostDate = True
                Else
                    IsPostDate = False
                End If
            End If
        End If
        On Error GoTo 0
    End With
End Property
Private Sub txtFindValue_KeyPress(KeyAscii As Integer)
    mblnKeyPress = True
End Sub

'判断操作员权限
Private Sub SetOpertarRight()
    Dim lngOperatorID As Long
    
    lngOperatorID = gclsBase.OperatorID
    '是否有工资报表查询权限
    If Not UserRight.IsCanDo(118, lngOperatorID) Then
        cmdWork(1).Enabled = False
        mblnIsRrportRight = False
    Else
        cmdWork(1).Enabled = True
        mblnIsRrportRight = True
    End If
    '是否有工资设置权限
    If Not UserRight.IsCanDo(115, lngOperatorID) Then
        mblnIsSetRight = False
    Else
        mblnIsSetRight = True
    End If
    '是否有工资录入权限
    If Not UserRight.IsCanDo(116, lngOperatorID) Then
        mblnIsInputRight = False
    Else
        mblnIsInputRight = True
    End If
End Sub

Public Sub SalaryListShow()
    Load Me
'    Set mclsGrid = New Grid
'    Set mclsGrid.Grid = msgSalaryList
'    mclsGrid.ListSet.ViewId = mintSalaryListViewID
'    Call JionGrid
'    mclsGrid.Sort 2, 1  '排序
'    If msgSalaryList.Rows > 1 Then
'        msgSalaryList.Row = 1
'        CmdFind.Visible = True
'    End If
'    Call CreateMenu
'    cboFind.Text = "工资表名称"
'    If msgSalaryList.Rows > 1 Then
'        msgSalaryList.ColSel = 5
'    End If
'    SetHelpID Me.hwnd, 60104
'    CmdFind.Enabled = True
    Me.Show
    Me.ZOrder 0
    cboFind.ListIndex = 0
    cboFind_Click
End Sub
Public Function SetNewSalarylist() As Boolean
    Dim lngOperatorID As Long
    
    lngOperatorID = gclsBase.OperatorID
     '是否有工资设置权限
    If UserRight.IsCanDo(115, lngOperatorID) Then
        SetNewSalarylist = True
        frmSalaryList.ShowSalaryList
        Call mnuNew
    Else
        SetNewSalarylist = False
    End If
    
End Function
Public Function SetInputSalarylist() As Boolean
    Dim lngOperatorID As Long
    
    lngOperatorID = gclsBase.OperatorID
    If UserRight.IsCanDo(116, lngOperatorID) Then
        frmSalaryList.ShowSalaryList
        If frmSalaryList.msgSalaryList.Rows > 1 Then
            frmSalaryList.msgSalaryList.Row = 1
            Call mnuInput
        End If
        SetInputSalarylist = True
    Else
        SetInputSalarylist = False
    End If
End Function
Public Sub ShowSalaryList()

    Me.MousePointer = vbHourglass
    Load Me
'    Set mclsGrid = New Grid
'    Set mclsGrid.Grid = msgSalaryList
    mclsGrid.ListSet.ViewId = mintSalaryListViewID
    Call JionGrid
    mclsGrid.Sort 2, 1  '排序
    If msgSalaryList.Rows > 1 Then
        msgSalaryList.Row = 1
        cmdFind.Visible = True
    End If
    cboFind.Text = "工资表名称"
    mlngFindCol = 2
    If msgSalaryList.Rows > 1 Then
        txtFindValue.Text = msgSalaryList.TextMatrix(1, 2)
    Else
        txtFindValue.Text = ""
    End If
    If msgSalaryList.Rows > 1 Then
        msgSalaryList.ColSel = msgSalaryList.Cols - 1
    End If
    cmdFind.Enabled = True
'    mblnSalaryInput = False
    Me.Show
    Me.ZOrder 0
    Me.MousePointer = vbDefault
End Sub