employeelist.frm

金算盘软件代码

      RowsetSize      =   100
      LoginTimeout    =   15
      KeysetSize      =   0
      MaxRows         =   0
      ErrorThreshold  =   -1
      BatchSize       =   15
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Enabled         =   -1  'True
      ReadOnly        =   0   'False
      Appearance      =   -1  'True
      DataSourceName  =   ""
      RecordSource    =   ""
      UserName        =   ""
      Password        =   ""
      Connect         =   ""
      LogMessages     =   ""
      Caption         =   "MSRDC1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSForms.CommandButton cmdDepEmp 
      Height          =   345
      Index           =   1
      Left            =   1200
      TabIndex        =   12
      TabStop         =   0   'False
      Tag             =   "1018"
      Top             =   4560
      Visible         =   0   'False
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "报表"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin VB.Label lblFind 
      AutoSize        =   -1  'True
      Caption         =   "内容(&C)"
      Height          =   180
      Left            =   2460
      TabIndex        =   2
      Top             =   150
      Width           =   630
   End
   Begin VB.Label lblFindKind 
      AutoSize        =   -1  'True
      Caption         =   "查找(&B)"
      Height          =   180
      Left            =   50
      TabIndex        =   0
      Top             =   150
      Width           =   630
   End
   Begin MSForms.CommandButton cmdDepEmp 
      Height          =   345
      Index           =   0
      Left            =   45
      TabIndex        =   10
      Tag             =   "1018"
      Top             =   3720
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
End
Attribute VB_Name = "frmEmployeeList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''
'   部门职员列表
'   作者：郑全
'   日期:98.6.23
'
'   引出属性:IsShowCard 功能：判断部门职员卡片是否关闭
'   引入参数：msgemployee 功能：判断部门职员卡片是否发出（增加或修改）改变消息
'
'''''''''''''''''''''''''''''''''''''''

Option Explicit

Private mIsShowCard(3) As Boolean                                  '卡片窗口显示标志
Private mblnCheckNoChange As Boolean                            '不需要响应chkshowAll控件Change事件
Private mblnComboxNoClick As Boolean

Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass          '钩子对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Private mclsList(3) As list                                    '列表对象
Attribute mclsList.VB_VarHelpID = -1
Private blnIsLoad(3) As Boolean
Private intViewID(3) As Integer
'Private mblnIsSaveListset(1) As Boolean              'Whether or not save lngViewID in list
'
'方法及函数
'
'产生部门职员列表记录集
Public Function GetList(ByVal intTab As Integer) As rdoResultset
    Dim recRecordset As rdoResultset
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    Dim strSql As String
    
    strSelectOfSql = mclsList(intTab).ListSet.GetSelect
    strFromOfSql = mclsList(intTab).ListSet.FromOfSql
    strWhereOfSql = mclsList(intTab).ListSet.WhereOfSql
    Select Case intTab
        Case 0
                strSelectOfSql = "Select Department.lngDepartmentID As id,decode(Department.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
                If Trim(strWhereOfSql) <> "" Then
                   strWhereOfSql = " Where " & strWhereOfSql
                End If
        Case 1
                strSelectOfSql = "Select Employee.lngEmployeeID As id,decode(Employee.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
                If Trim(strWhereOfSql) <> "" Then
                   strWhereOfSql = " Where " & strWhereOfSql
                End If
        Case 2
                strSelectOfSql = "Select PersonTax.lngPersonTaxID As id,'' As ""停用""," & strSelectOfSql
                If Trim(strWhereOfSql) <> "" Then
                   strWhereOfSql = " Where " & strWhereOfSql
                End If
        Case 3
                strSelectOfSql = "Select PersonTaxType.lngPersonTaxTypeID As id,'' As ""停用""," & strSelectOfSql
                If Trim(strWhereOfSql) <> "" Then
                   strWhereOfSql = " Where " & strWhereOfSql
                End If
        End Select
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
    'Debug.Print strSql
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    '列表是否为空
    If recRecordset.RowCount = 0 Then
        mclsList(intTab).FlexGrid.HighLight = flexHighlightNever
        cmdAgain.Enabled = False
    Else
        mclsList(intTab).FlexGrid.HighLight = flexHighlightAlways
        cmdAgain.Enabled = True
    End If
    mclsList(intTab).ShowAll = True
    
    Set GetList = recRecordset
End Function
Public Function ShowList(ByVal lngID As Long, Optional intTab As Integer = 0) As Boolean
    Dim intCount As Integer
    Dim strSortField As String
    Dim strSortDec As String
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim strofFrom As String
    Dim strofWhere As String
'    Me.Show
'    Me.ZOrder 0
    With frmMain.mnuListDepartment
        If IsNumeric(.Tag) Then
            If CLng(.Tag) > 0 Then
                BringWindowToTop .Tag
            Else
                Me.BindingResultSet
            End If
        Else
            Me.BindingResultSet
        End If
    End With
    Me.sstDepEmp.Tab = intTab
    With mclsList(intTab).ListSet
        '得到排序字段
        For intCount = 1 To .Columns
            If .ColumnOrderType(intCount) <> 0 Then
                strSortField = .ColumnFieldName(intCount)
                strSortDec = .ColumnDesc(intCount)
                Exit For
            End If
        Next
        If intCount > .Columns Then
            ShowList = False
            Exit Function
        End If
        strofFrom = .FromOfSql
        strofWhere = .WhereOfSql
    End With
    '根据lngID得到排序字段值
    strSql = "Select " & strSortField & " As " & strSortDec
    Select Case intTab
        Case 0
            If Trim(strofWhere) <> "" Then
                strofWhere = " where " & strofWhere & " and Department.lngDepartmentID=" & lngID
            Else
                strofWhere = " where Department.lngDepartmentID=" & lngID
            End If
        Case 1
            If Trim(strofWhere) <> "" Then
                strofWhere = " where " & strofWhere & " and Employee.lngEmployeeID=" & lngID
            Else
                strofWhere = " where Employee.lngEmployeeID=" & lngID
            End If
        Case 2
            If Trim(strofWhere) <> "" Then
                strofWhere = " where " & strofWhere & " and PersonTax.lngPersonTaxID=" & lngID
            Else
                strofWhere = " where PersonTax.lngPersonTaxID=" & lngID
            End If
        Case 3
            If Trim(strofWhere) <> "" Then
                strofWhere = " where " & strofWhere & " and PersonTaxType.lngPersonTaxTypeID=" & lngID
            Else
                strofWhere = " where PersonTaxType.lngPersonTaxTypeID=" & lngID
            End If
    End Select
    strSql = strSql & strofFrom & strofWhere
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recTemp
        If .RowCount > 0 Then
            txtfind.Text = recTemp(strSortDec)   '查找
            With mclsList(intTab).FlexGrid
                If .TextMatrix(.Row, 0) = lngID Then      '是否找到
                    ShowList = True
                Else
                    ShowList = False
                End If
            End With
        Else
            ShowList = False
        End If
        .Close
    End With
End Function

'卡片
Public Property Let IsShowCard(ByVal Index As Integer, ByVal vNewValue As Boolean)
   mIsShowCard(Index) = vNewValue
   
End Property
Public Property Get IsShowCard(ByVal Index As Integer) As Boolean
   IsShowCard = mIsShowCard(Index)
End Property
'按照部门职员ID提取记录
Public Function GetbyListID(ByVal intTab As Integer, ByVal lngID As Long) As rdoResultset
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    Select Case intTab
        Case 0
            strSql = "Select * From Department Where lngDepartmentID = " & lngID
        Case 1
            strSql = "Select * From Employee Where lngEmployeeID = " & lngID
        Case 2
            strSql = "Select * From PersonTax Where lngPersonTaxID = " & lngID
        Case 3
            strSql = "Select * From PersonTaxType Where lngPersonTaxTypeID = " & lngID
    End Select
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set GetbyListID = recRecordset
End Function

'按照部门职员ID更新停用标志
Private Function UpdateListInActive(ByVal intTab As Integer, ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSql As String
    
    Select Case intTab
        Case 0
            strSql = "UPDATE Department SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngDepartmentID = " & lngID
        Case 1
            strSql = "UPDATE Employee SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngEmployeeID = " & lngID
        Case 2
            strSql = "UPDATE PersonTax SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngPersonTaxID = " & lngID
        Case 3
            strSql = "UPDATE PersonTaxType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngPersonTaxTypeID = " & lngID
    End Select
    UpdateListInActive = gclsBase.ExecSQL(strSql)
End Function

'删除部门职员ID指定记录
Private Function DelByPaymentMethodID(ByVal lngID As Long, ByVal intTab As Integer) As Boolean
    Dim strSql As String
    
    Select Case intTab
        Case 0
            strSql = "Delete  From Department WHERE lngDepartmentID = " & lngID
        Case 1
            strSql = "Delete  From Employee WHERE lngEmployeeID = " & lngID
        Case 2
            strSql = "Delete  From PersonTax WHERE lngPersonTaxID = " & lngID
        Case 3
            strSql = "Delete  From PersonTaxType WHERE lngPersonTaxTypeID = " & lngID
    End Select
    DelByPaymentMethodID = gclsBase.ExecSQL(strSql)
End Function

'判断部门职员ID是否使用
Private Function IsUsePaymentMethodID(ByVal lngID As Long) As Boolean
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    Select Case sstDepEmp.Tab
           Case 0
                strSql = "Select lngDepartmentID From ActivityDetail Where lngdepartmentID = " & lngID
           Case 1
                strSql = "Select lngEmployeeID From ActivityDetail Where lngemployeeID = " & lngID
    End Select
    
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    IsUsePaymentMethodID = (recRecordset.RowCount >= 1)
    recRecordset.Close
End Function

' 部门职员ID
Public Property Get ListID(ByVal intTab As Integer) As Long
    With mclsList(intTab).FlexGrid
        If .TextArray(.Row * .Cols) <> "" And .Row > 0 Then
            ListID = CLng(.TextArray(.Row * .Cols))
        Else
            ListID = 0
        End If
    End With
End Property

' 部门职员停用标志
Public Property Get ListIsInActive(ByVal intTab As Integer) As Boolean
    If chkShowAll.Value Then
        With mclsList(intTab).FlexGrid
            ListIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        ListIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    Dim IsHaveRight As Boolean
    
    IsHaveRight = IsCanDo(12, gclsBase.OperatorID)
    With mclsList(sstDepEmp.Tab).FlexGrid
        If .Rows > 1 And .ColSel <> 0 And .RowHeight(.Row) > 0 Then
            blnIsnotEmpty = True