frmemployeelistcard.frm

金算盘软件代码

    ElseIf dtmEmployee(1).Text > dtmEmployee(2).Text And dtmEmployee(2).Text <> "" Then
        ShowMsg hwnd, "入职日期不能大于离职日期！", vbExclamation + MB_TASKMODAL, Caption
        dtmEmployee(1).Text = mstrLastDate(1)
        dtmEmployee(1).SetFocus
    Else
        CheckDate = True
    End If
End Function
'Private Sub chkStop_LostFocus(Index As Integer)
' If chkStop(Index).Tag <> chkStop(Index).Value Then Exit Sub
' mblnIsChanged = IsChanged
'End Sub
'
Private Sub cmdOK_Click(Index As Integer)
 Dim strSql As String, strNextCode As String
 Dim recEmp As rdoResultset
    If Index = 0 Then
        If mblnIsChanged Then
            If Not SaveCard Then
               Exit Sub
            End If
        End If
        Unload Me
    ElseIf Index = 2 Then
        If mblnIsChanged Then
            If SaveCard Then
                mblnIsNew = True
                strNextCode = GetNextCode(txtEmployee(0).Text)
                InitCard
                txtEmployee(0).Text = strNextCode
                txtEmployee(0).SetFocus
                txtEmployee(0).SelStart = 0
                txtEmployee(0).SelLength = Len(txtEmployee(0).Text)
            End If
        End If
    ElseIf Index = 4 Then    '调记事
        mstrNotes = frmNotePad.EditCard(Me.Caption, txtEmployee(0).Text, _
            txtEmployee(1).Text, mstrNotes)   '调记事
    ElseIf Index = 1 Then
        Unload Me
    End If
End Sub

Private Function InitCard(Optional strName As String = "") As Boolean
    Dim i As Integer
    Dim strSql As String
    Dim recEmp As rdoResultset

    InitCard = True
    mblnIsInit = True
    mlngDEmployeeID = 0
    cboSex.Clear
    cboSex.AddItem "男"
    cboSex.AddItem "女"
    chkStop(1).Value = Unchecked
    If Not mblnIsNew Then
        strSql = "SELECT * FROM EMPLOYEEVIEW WHERE lngEmployeeID=" & mlngEmployeeID
        Set recEmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        If recEmp.EOF Then
            InitCard = False
            recEmp.Close
            Exit Function
        Else
            With recEmp
            cmdOK(2).Visible = False
            cmdOK(4).Move cmdOK(2).Left, cmdOK(2).top
            lstText(0).Text = Format(!strDepartmentCode, "@;;") & " " & Format(!strDepartmentName, "@;;")
            lstText(1).Text = Format(!strEmployeeTypeCode, "@;;") & " " & Format(!strEmployeeTypeName, "@;;")
            lstText(2).Text = Format(!strEducationName, "@;;")
            lstText(3).Text = Format(!strTitleName, "@;;")
            lstText(4).Text = Format(!strPersonTaxTypeName, "@;;")
            
            mlngLastID(0) = !lngDepartmentID
            mlngLastID(1) = !lngEmployeeTypeID
            mlngLastID(2) = !lngEducationID
            mlngLastID(3) = !lngTitleID
            mlngLastID(4) = !lngPersonTaxTypeID
            For i = 0 To 4
                mlngLstID(i) = mlngLastID(i)
            Next i
            
            txtEmployee(0).Text = !strEmployeeCode
'            mstrLastCode = txtEmployee(0).Text
            mstrLastTxt(0) = !strEmployeeCode
            txtEmployee(1).Text = !strEmployeeName
'            mstrLastName = txtEmployee(1).Text
            mstrLastTxt(1) = txtEmployee(1).Text
            mstrEmployee = txtEmployee(0).Text & " " & txtEmployee(1).Text
            
            txtEmployee(2).Text = Trim(Format(!strBankCode, "@;;"))
            mstrLastTxt(2) = txtEmployee(2).Text
            txtEmployee(3).Text = Trim(Format(!strOfficePhone, "@;;"))
            mstrLastTxt(3) = txtEmployee(3).Text
            txtEmployee(4).Text = Trim(Format(!strHomePhone, "@;;"))
            mstrLastTxt(4) = txtEmployee(4).Text
            txtEmployee(5).Text = Trim(Format(!strPostalCode, "@;;"))
            mstrLastTxt(5) = txtEmployee(5).Text
            txtEmployee(6).Text = Trim(Format(recEmp!strAddress, "@;;"))
            mstrLastTxt(6) = txtEmployee(6).Text
            chkStop(0).Value = !blnIsInActive
            mintLastchk(0) = chkStop(0).Value
            chkStop(1).Value = !blnIsPersonTax
            mintLastchk(1) = chkStop(1).Value
            cboSex.ListIndex = !blnIsMale
            mstrLastCbo = cboSex.Text
            dtmEmployee(0).Text = Trim(Format(!strBirthdate, "@;;"))
            mstrLastDate(0) = dtmEmployee(0).Text
            dtmEmployee(1).Text = Trim(Format(!strInDate, "@;;"))
            mstrLastDate(1) = dtmEmployee(1).Text
            dtmEmployee(2).Text = Trim(Format(!strOutDate, "@;;"))
            mstrLastDate(2) = dtmEmployee(2).Text
            mstrNotes = Trim(Format(!strNotes, "@;;"))
            mstrLastNotes = mstrNotes
            .Close
            End With
        End If
    Else
        cmdOK(2).Visible = True
        chkStop(0).Value = Unchecked
        Caption = "增加职员"
        dtmEmployee(0).Text = ""
        dtmEmployee(1).Text = ""
        dtmEmployee(2).Text = ""
        For i = 1 To 6
            txtEmployee(i).Text = ""
            mstrLastTxt(i) = ""
        Next
        txtEmployee(0).Text = Trim(strName)
        mstrNotes = ""
        mstrLastNotes = ""
        For i = 0 To 4
            lstText(i).Text = ""
            mlngLstID(i) = 0
            mlngLastID(i) = 0
        Next i
        For i = 0 To 2
            mstrLastDate(i) = ""
        Next i
        mstrLastCbo = ""
        mintLastchk(0) = 0
        mintLastchk(1) = 0
        cboSex.ListIndex = 0
    End If
    chkStop_Click 1
    mblnIsInit = False

End Function

Private Function IsCanDel(ByVal lngID As Long) As Boolean
    
    IsCanDel = False
    
    If CheckIDUsed("AccountBalance", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("ARAPInit", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("AccountDetail", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("ActivityDetail", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("CostPrice", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("Customer", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("ItemBalance", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("ItemBudget", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("ItemDaily", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("Job", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("PurchaseInvoice", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("PurchaseOrder", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("PurchaseQuote", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("SaleInvoice", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("SaleOrder", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("SaleQuote", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("stockTaking", "lngEmployeeID", lngID) Then Exit Function
'    If CheckIDUsed("TimeSheet", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("TransVoucherDetail", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("VoucherDetail", "lngEmployeeID", lngID) Then Exit Function
    IsCanDel = True
End Function

Private Function MergeCode() As Boolean
    
    MergeCode = False
    If Not DisplaceActivity("AccountBalance", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("ARAPInit", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("CostPrice", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("Customer", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("PurchaseOrder", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("SaleOrder", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("stockTaking", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("VoucherDetail", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    MergeCode = True
End Function

Private Sub dtmEmployee_Change(Index As Integer)
    If mblnIsInit Then Exit Sub
    mblnIsChanged = True
End Sub

Private Sub SetForm()
    lblNote(0).Left = 150
    lblNote(0).top = 270
    lblNote(1).Left = 150
    lblNote(1).top = 755
    lblNote(4).Left = 150
    lblNote(4).top = 1240
    lblNote(6).Left = 150
    lblNote(6).top = 1725
    lblNote(10).Left = 150
    lblNote(10).top = 2210
    lblNote(13).Left = 150
    lblNote(13).top = 2695
    lblNote(15).Left = 150
    lblNote(15).top = 3180
    lblNote(2).Left = 2580
    lblNote(2).top = 270
    lblNote(3).Left = 2580
    lblNote(3).top = 755
    lblNote(5).Left = 2580
    lblNote(5).top = 1240
    lblNote(9).Left = 2580
    lblNote(9).top = 1725
    lblNote(12).Left = 2580
    lblNote(12).top = 2210
    lblNote(8).Left = 2580
    lblNote(8).top = 2695
    lblNote(16).Left = 2580
    lblNote(16).top = 3180
    txtEmployee(0).Left = 1140
    txtEmployee(0).top = 270
    cboSex.Left = 1140
    cboSex.top = 755
    lstText(1).Left = 1140
    lstText(1).top = 1240
    lstText(3).Left = 1140
    lstText(3).top = 1725
    dtmEmployee(1).Left = 1140
    dtmEmployee(1).top = 2210
    txtEmployee(4).Left = 1140
    txtEmployee(4).top = 2695
    txtEmployee(5).Left = 1140
    txtEmployee(5).top = 3180
    txtEmployee(1).Left = 3570
    txtEmployee(1).top = 270
    lstText(0).Left = 3570
    lstText(0).top = 755
    lstText(2).Left = 3570
    lstText(2).top = 1240
    dtmEmployee(0).Left = 3570
    dtmEmployee(0).top = 1725
    dtmEmployee(0).Width = 1875
    dtmEmployee(2).Left = 3570
    dtmEmployee(2).top = 2210
    dtmEmployee(2).Width = 1875
    txtEmployee(3).Left = 3570
    txtEmployee(3).top = 2695
    txtEmployee(6).Left = 3570
    txtEmployee(6).top = 3180
    lblNote(7).Visible = False
    txtEmployee(2).Visible = False
    lblNote(11).Visible = False
    chkStop(1).Visible = False
    lblNote(14).Visible = False
    lstText(4).Visible = False
End Sub

Private Sub Form_Activate()
    mclsMainControl_ChildActive
    frmMain.mnuEditShowList = True
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub Form_Load()
    Dim i As Integer
    
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    SetHelpID hwnd, 30010
    frmEmployeeList.IsShowCard(1) = True
    For i = 0 To 4
        mblnIsFirst(i) = True
    Next
    #If conVersionType = 8 Then
        SetForm
    #End If
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 60, 150, 5595, 3525
    #If conVersionType <> 8 Then
        FrameBox Me.hwnd, 2580, 2220, 5445, 3135
    #End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer, strMess As String
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If Trim(txtEmployee(0).Text & txtEmployee(1).Text) = "" Then Exit Sub
    If mblnIsChanged Then
        If mblnIsNew Then
            strMess = "您要保存新增的职员"
            If txtEmployee(0).Text <> "" Then
                strMess = strMess & "“" & txtEmployee(0).Text & "”"
            End If
            If txtEmployee(1).Text <> "" Then
                strMess = strMess & "“" & txtEmployee(1).Text & "”"
            End If
            strMess = strMess & "吗？"
        Else
            strMess = "“" & txtEmployee(0).Text & "”" & " " _
                & "“" & txtEmployee(1).Text & "”职员已被修改，是否保存？"
        End If
        intMsgReturn = ShowMsg(hwnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmEmployeeList.IsShowCard(1) = False
    mblnIsChanged = False
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub GetLstValue()
    Dim i As Integer
    
    For i = 0 To 4
        If Trim(lstText(i).Text) = "" Then mlngLstID(i) = 0
    Next i
End Sub

Private Function SaveCard() As Boolean
    Dim blnMergeCode As Boolean
    Dim intResult As Integer    '编码检查结果:1--合法 -1--编码重复 -2--名称重复
    Dim recEmployee As rdoResultset, strSql As String
    Dim strBill As String, strOffice As String, strHome As String
    Dim strPost As String, strAddr As String, strBirthDay As String
    Dim strInDay As String, strOutDay As String
 
  '需要事务处理
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    SaveCard = False
    If Trim$(txtEmployee(0).Text) = "" Then
        ShowMsg hwnd, "职员编码不能为空！", vbExclamation, Caption
        txtEmployee(0).SetFocus
        GoTo ErrHandle
    End If
    If Trim$(txtEmployee(1).Text) = "" Then
        ShowMsg hwnd, "职员名称不能为空！", vbExclamation, Caption
        txtEmployee(1).SetFocus
        GoTo ErrHandle
    End If