employeelist.frm

金算盘软件代码

            mclsList(.Tab).InitFlexGrid
           
            Set datEmployee(.Tab).Resultset = GetList(.Tab)
            If datEmployee(sstDepEmp.Tab).Resultset.RowCount > 0 Then
               datEmployee(sstDepEmp.Tab).Resultset.MoveLast
            End If
            datEmployee(sstDepEmp.Tab).Resultset.Close
'            Set datEmployee(sstDepEmp.Tab).Recordset = Nothing
            mclsList(.Tab).SetFlexGrid
            
            '初始化查找复合列表框
            mclsList(.Tab).InitcboFindKind
            mclsList(sstDepEmp.Tab).FlexGrid.Redraw = False
            '重画窗体
           ' RedrawForm
            '定位到第一行
            With mclsList(.Tab).FlexGrid
                If .Rows > 1 Then
                    mclsList(sstDepEmp.Tab).FlexNoChange = False
                    .Row = 1
                    mclsList(sstDepEmp.Tab).FlexNoChange = True
                End If
                .col = 0
                .ColSel = .Cols - 1
            End With
           ' chkShowAll.Value = False
            mclsList(.Tab).DoShowAll blnOldShowAll
            UpdateMenuStatus
            blnIsLoad(.Tab) = True
        Else
            '恢复查找复合列表项
            mblnComboxNoClick = True
            mclsList(.Tab).InitcboFindKind
            mblnComboxNoClick = False
            '恢复查找内容
            If mclsList(.Tab).FlexGrid.Rows > 1 And mclsList(.Tab).FlexGrid.ColSel > 0 Then
                txtfind.Text = mclsList(.Tab).FlexGrid.TextMatrix(mclsList(.Tab).FlexGrid.Row, mclsList(.Tab).SortCol)
            Else
                txtfind.Text = ""
            End If
            '恢复“全部显示”复选框
            mblnCheckNoChange = True
            chkShowAll.Value = IIf(mclsList(.Tab).ShowAll, 1, 0)
            UpdateMenuStatus
            mblnCheckNoChange = False
        End If
'        If .Tab = 2 Then InItNewRate
'        If chkNewRate.Value = 1 Then SaveNewRate
        RedrawForm
        mclsList(.Tab).FlexNoChange = False
        mclsList(.Tab).FindNoChange = False
        mclsList(sstDepEmp.Tab).FlexGrid.Redraw = True
        If mclsList(sstDepEmp.Tab).FlexGrid.Row = 0 Then mclsList(sstDepEmp.Tab).FlexGrid.col = 0
    End With
End Sub

'Private Sub txtAmount_Change()
'    'If Not IsNumeric(txtAmount.Text) Then BKKEY txtAmount.hwnd
'    'If InStr(txtAmount.Text, ",") > 0 Then BKKEY txtAmount.hwnd
'    If txtAmount.Text Like "0[0,1,2,3,4,5,6,7,8,9]*" Then BKKEY txtAmount.hwnd
'    If CDbl(Val(txtAmount.Text)) < 0 Then BKKEY txtAmount.hwnd
'End Sub

'Private Sub txtAmount_KeyPress(KeyAscii As Integer)
'    If KeyAscii <> 13 And KeyAscii <> 8 And KeyAscii <> 46 And (KeyAscii < 48 Or KeyAscii > 57) Then
'        BKKEY txtAmount.hwnd
'    End If
'End Sub

'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList(sstDepEmp.Tab).TextFind txtfind.Text
    
End Sub


'
' FLEXGRID控件
'

'双击FLEXGRID调用卡片
Private Sub msgPaymentMethod_DblClick()
    With mclsList(sstDepEmp.Tab).FlexGrid
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
            mclsMainControl_EditEdit
        End If
    End With
End Sub

'恢复“停用”列光标
Private Sub msgdepartment_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   With msgDepartment
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
  
End Sub




'
'响应主控对象事件
'

'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Dim lngID As Long
    lngID = ListID(sstDepEmp.Tab)
    Me.Enabled = False
    Select Case sstDepEmp.Tab
        Case 0
            If lngID > 0 Then
                If CheckIDUsed("Department", "lngDepartmentID", lngID) Then
'                    frmDepartmentListCard.EditCard lngID
                    frmDepartmentCard.EditCard lngID, vbModal
                    Set frmDepartmentCard = Nothing
                Else
                    ShowMsg 0, "该部门不存在,不能进行修改！", _
                            vbExclamation + MB_TASKMODAL, "修改部门"
                    ToolRefresh sstDepEmp.Tab
                End If
            End If
        Case 1
            If lngID > 0 Then
                If CheckIDUsed("Employee", "lngEmployeeID", lngID) Then
'                    frmEmployeeListCard.EditCard lngID
                    frmEmployeeCard.EditCard lngID, vbModal
                    Set frmEmployeeCard = Nothing
                Else
                    ShowMsg 0, "该职员不存在,不能进行修改！", _
                            vbExclamation + MB_TASKMODAL, "修改职员"
                    ToolRefresh sstDepEmp.Tab
                End If
            End If
        Case 2
            If lngID > 0 Then
                If CheckIDUsed("PersonTax", "lngPersonTaxID", lngID) Then
'                    frmPersonTaxListCard.EditCard lngID
                    frmPersonTax.EditCard lngID, vbModal
                    Set frmPersonTax = Nothing
                Else
                    ShowMsg 0, "该个人所得税不存在,不能进行修改！", _
                            vbExclamation + MB_TASKMODAL, "个人所得税率"
                    ToolRefresh sstDepEmp.Tab
                End If
            End If
        Case 3
            If lngID > 0 Then
                If CheckIDUsed("PersonTaxType", "lngPersonTaxTypeID", lngID) Then
'                    frmTaxTypeListcard.EditCard lngID
                    frmTax.EditCard lngID, vbModal
'                    Set frmTax = Nothing
                Else
                    ShowMsg 0, "该扣税标准不存在,不能进行修改！", _
                            vbExclamation + MB_TASKMODAL, "扣税标准卡片"
                    ToolRefresh sstDepEmp.Tab
                End If
            End If
    End Select
    Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
    Select Case sstDepEmp.Tab
        Case 0
'            frmDepartmentListCard.AddCard
            frmDepartmentCard.AddCard , vbModal
            Set frmDepartmentCard = Nothing
        Case 1
'            frmEmployeeListCard.AddCard
            frmEmployeeCard.AddCard , vbModal
            Set frmEmployeeCard = Nothing
        Case 2
'            frmPersonTaxListCard.AddCard
            frmPersonTax.AddCard vbModal
            Set frmPersonTax = Nothing
        Case 3
'            frmTaxTypeListcard.AddCard
            frmTax.AddCard
            Set frmTax = Nothing
    End Select
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()

    Dim lngID As Long
    Dim intDelRow As Integer
    lngID = ListID(sstDepEmp.Tab)
    Dim blnSucess As Boolean
    blnSucess = False
    intDelRow = mclsList(sstDepEmp.Tab).FlexGrid.Row
    Select Case sstDepEmp.Tab
        Case 0
            If mIsShowCard(0) Then
'                If lngID = frmDepartmentListCard.getID And lngID > 0 Then
                If lngID = frmDepartmentCard.getID And lngID > 0 Then
                    MsgBox "不能删除当前编辑的部门！", vbExclamation
'                    frmDepartmentListCard.Show
'                    frmDepartmentListCard.ZOrder 0
                    frmDepartmentCard.EditCard lngID, vbModal
                    Set frmDepartmentCard = Nothing
                    Exit Sub
                End If
            End If
'            If frmDepartmentListCard.DelCard(ListID(sstDepEmp.Tab)) Then
            If frmDepartmentCard.DelCard(ListID(sstDepEmp.Tab)) Then
                UpDatePreFlage
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgDepartment
            End If
            Unload frmDepartmentCard
            Set frmDepartmentCard = Nothing
            'If Not frmDepartmentListCard.Visible Then
'            Unload frmDepartmentListCard
        Case 1
            If mIsShowCard(1) Then
'                If lngID = frmEmployeeListCard.getID And lngID > 0 Then
                If lngID = frmEmployeeCard.getID And lngID > 0 Then
                    MsgBox "不能删除当前编辑的职员！", vbExclamation
'                    frmEmployeeListCard.Show
'                    frmEmployeeListCard.ZOrder 0
                    frmEmployeeCard.EditCard lngID, vbModal
                    Set frmEmployeeCard = Nothing
                    Exit Sub
                End If
            End If
'            If frmEmployeeListCard.DelCard(ListID(sstDepEmp.Tab)) Then
            If frmEmployeeCard.DelCard(ListID(sstDepEmp.Tab)) Then
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgEmployee
            End If
            Unload frmEmployeeCard
            Set frmEmployeeCard = Nothing
            'If Not frmEmployeeListCard.Visible Then
'            Unload frmEmployeeListCard
        Case 2
            If mIsShowCard(2) Then
'                If lngID = frmPersonTaxListCard.getID and lngid>0 Then
'                    MsgBox "不能删除当前编辑的职员！", vbExclamation
'                    frmPersonTaxListCard.Show
'                    frmPersonTaxListCard.ZOrder 0
'                    Exit Sub
'                End If
            End If
'            If frmPersonTaxListCard.DelCard(ListID(sstDepEmp.Tab)) Then
            If frmPersonTax.DelCard(ListID(sstDepEmp.Tab), Me.hwnd, True) Then
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgPersonTax
            End If
            Unload frmPersonTax
            Set frmPersonTax = Nothing
            'If Not frmEmployeeListCard.Visible Then
'            Unload frmPersonTaxListCard
        Case 3
            If mIsShowCard(3) Then
'                If lngID = frmTaxTypeListcard.getID And lngID > 0 Then
                If lngID = frmTax.getID And lngID > 0 Then
                    MsgBox "不能删除当前编辑的扣税标准！", vbExclamation
'                    frmTaxTypeListcard.Show
'                    frmTaxTypeListcard.ZOrder 0
                    frmTax.EditCard lngID, vbModal
                    Set frmTax = Nothing
                    Exit Sub
                End If
            End If
'            If frmTaxTypeListcard.DelCard(ListID(sstDepEmp.Tab)) Then
            If frmTax.DelCard(ListID(sstDepEmp.Tab), , True) Then
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgTaxType
            End If
            Unload frmTax
            Set frmTax = Nothing
            'If Not frmEmployeeListCard.Visible Then
'            Unload frmTaxTypeListcard
    End Select
    If blnSucess Then
        With mclsList(sstDepEmp.Tab).FlexGrid
            .RowHeight(intDelRow) = 0
            .RowData(intDelRow) = 1
        End With
        mclsList(sstDepEmp.Tab).SetFlexRow
    End If
    
    UpdateMenuStatus
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    With sstDepEmp
        Select Case .Tab
            Case 0
                CeaseLower
            Case 1
                If UpdateListInActive(.Tab, ListID(.Tab), Not ListIsInActive(.Tab)) Then
                   With mclsList(.Tab).FlexGrid
                        If chkShowAll.Value Then
                           If .TextMatrix(.Row, 1) = "" Then
                               .TextMatrix(.Row, 1) = "√"
                           Else
                               .TextMatrix(.Row, 1) = ""
                           End If
                        Else
                           .TextMatrix(.Row, 1) = "√"
                           .RowHeight(.Row) = 0
                           mclsList(sstDepEmp.Tab).SetFlexRow
                        End If
                   End With
                    ' 发出职员消息
                     If .Tab = 1 Then gclsSys.SendMessage CStr(Me.hwnd), Message.msgEmployee
                     
                End If
            End Select
    End With
    UpdateMenuStatus
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    If chkShowAll.Value = 0 Then
        chkShowAll.Value = 1
    Else
        chkShowAll.Value = 0
    End If
End Sub

'引用编码
Private Sub mclsMainControl_EditUse()
     Select Case sstDepEmp.Tab
        Case 0
            UseCode Message.msgDepartment, ListID(0)
        Case 1
            UseCode Message.msgEmployee, ListID(1)
        Case 2
            UseCode Message.msgPersonTax, ListID(2)
        Case 3
            UseCode Message.msgTaxType, ListID(3)
    End Select
    Me.ZOrder 1
End Sub

'搜索
Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
End Sub

Private Sub ToolRefresh(ByVal intTab As Integer)