frmempcardnew.frm

金算盘软件代码

Private Sub chkActive_Click(Index As Integer)
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub chkStop_Click(Index As Integer)
'    Dim strEmp As String
'
'    strEmp = txtEmployee(0).Text & " " & txtEmployee(1).Text
    Select Case Index
    Case 0
'        If chkStop(0).Value = Checked And Not mblnIsNew Then
'            If Not IsCanDel(mlngEmployeeID) Then
'                ShowMsg hwnd, "职员“" & strEmp & "”已经发生业务,不能停用！", vbExclamation, Caption
'                chkStop(0).Value = Unchecked
'            End If
'        End If
    Case 1
        If chkStop(1).Value = Checked Then
            lstText(4).Enabled = True
            lstText(4).BackColor = &H80000005
            lstText(4).TabStop = True
            If mblnIsFirst(4) Then lstText_GotFocus 4
            If lstText(4).Referrows > 3 And Not mblnIsInit Then
                lstText(4).Text = lstText(4).TextMatrix(4, 2)
                mlngLstID(4) = lstText(4).TextMatrix(4, 1)
            End If
        Else
            lstText(4).Enabled = False
            lstText(4).Text = ""
            lstText(4).TabStop = False
            mlngLstID(4) = 0
            lstText(4).BackColor = &H80000004
        End If
    Case 2
        If chkStop(2).Value = Checked Then
            txtEmployee(2).Enabled = True
            txtEmployee(2).TabStop = True
            txtEmployee(2).BackColor = &H80000005
            lstText(5).Enabled = True
            lstText(5).TabStop = True
            lstText(5).BackColor = &H80000005
        Else
            txtEmployee(2).Enabled = False
            txtEmployee(2).TabStop = False
            txtEmployee(2).Text = ""
            txtEmployee(2).BackColor = &H80000004
            lstText(5).Enabled = False
            lstText(5).TabStop = False
            lstText(5).Text = ""
            lstText(5).BackColor = &H80000004
            mlngLstID(5) = 0
        End If
    End Select
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub chkStop_GotFocus(Index As Integer)
     chkStop(Index).Tag = chkStop(Index).Value
End Sub

Private Function CheckDate(Optional ByVal blnByAdd As Boolean = False) As Boolean
    CheckDate = False
    If dtmEmployee(0).Text >= dtmEmployee(1).Text And dtmEmployee(1).Text <> "" Then
        If Not blnByAdd Then
            ShowMsg hwnd, "出生日期不能大于等于入职日期！", vbExclamation + MB_TASKMODAL, Caption
            dtmEmployee(0).Text = mstrLastDate(0)
            dtmEmployee(0).SetFocus
        End If
    ElseIf dtmEmployee(0).Text >= dtmEmployee(2).Text And dtmEmployee(2).Text <> "" Then
        If Not blnByAdd Then
            ShowMsg hwnd, "出生日期不能大于等于离职日期！", vbExclamation + MB_TASKMODAL, Caption
            dtmEmployee(0).Text = mstrLastDate(0)
            dtmEmployee(0).SetFocus
        End If
    ElseIf dtmEmployee(1).Text > dtmEmployee(2).Text And dtmEmployee(2).Text <> "" Then
        If Not blnByAdd Then
            ShowMsg hwnd, "入职日期不能大于离职日期！", vbExclamation + MB_TASKMODAL, Caption
            dtmEmployee(1).Text = mstrLastDate(1)
            dtmEmployee(1).SetFocus
        End If
    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 mblnIsExist Then Exit Sub
    If Index = 0 Then
        If mblnIsChanged Then
            If Not SaveCard Then
               Exit Sub
            End If
        End If
        Unload Me
    ElseIf Index = 2 Then
        mblnIsNext = True
        If mblnIsChanged Then
            If SaveCard Then
                mblnIsNew = True
                strNextCode = GetNextCode(txtEmployee(0).Text)
                InitCard
                SSTab1.Tab = 0
                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)   '调记事
        mblnIsChanged = True
    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
    If Not mblnIsNew Then
        strSql = "SELECT * FROM EMPLOYEEVIEW WHERE lngEmployeeID=" & mlngEmployeeID
        Set recEmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        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, "@;;")
            lstText(5).Text = Format(!strbankname, "@;;")
            mlngLastID(0) = !lngDepartmentID
            mlngLastID(1) = !lngEmployeeTypeID
            mlngLastID(2) = !lngEducationID
            mlngLastID(3) = !lngTitleID
            mlngLastID(4) = !lngPersonTaxTypeID
            mlngLastID(5) = !lngBankID
            For i = 0 To 5
                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(!strBankCode)
            mstrLastTxt(2) = txtEmployee(2).Text
            txtEmployee(3).Text = Trim(!strOfficePhone)
            mstrLastTxt(3) = txtEmployee(3).Text
            txtEmployee(4).Text = Trim(!strHomePhone)
            mstrLastTxt(4) = txtEmployee(4).Text
            txtEmployee(5).Text = Trim(!strPostalCode)
            mstrLastTxt(5) = txtEmployee(5).Text
            txtEmployee(6).Text = Trim(recEmp!strAddress)
            mstrLastTxt(6) = txtEmployee(6).Text
            txtEmployee(7).Text = Trim(!strCardNo)
            mstrLastTxt(7) = txtEmployee(7).Text
            chkStop(0).Value = !blnIsInActive
            mintLastchk(0) = chkStop(0).Value
            chkStop(1).Value = !blnIsPersonTax
            mintLastchk(1) = chkStop(1).Value
            chkStop(2).Value = !blnIsBank
            optSex(1).Value = (!blnIsMale = 0)
            dtmEmployee(0).Text = Trim(!strBirthdate)
            mstrLastDate(0) = dtmEmployee(0).Text
            dtmEmployee(1).Text = Trim(!strIndate)
            mstrLastDate(1) = dtmEmployee(1).Text
            dtmEmployee(2).Text = Trim(!strOutdate)
            mstrLastDate(2) = dtmEmployee(2).Text
            mstrNotes = Trim(Format(!strNotes, "@;;"))
            mstrLastNotes = mstrNotes
            chkActive(0).Value = IIf(!blnAccount, 1, 0)
            chkActive(1).Value = IIf(!blnAR, 1, 0)
            chkActive(2).Value = IIf(!blnAP, 1, 0)
            chkActive(3).Value = IIf(!blnCash, 1, 0)
            chkActive(4).Value = IIf(!blnPurchase, 1, 0)
            chkActive(5).Value = IIf(!blnSale, 1, 0)
            chkActive(6).Value = IIf(!blnStock, 1, 0)
            chkActive(7).Value = IIf(!blnEntrust, 1, 0)
            .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 = 0 To 7
            If i > 0 Then
                txtEmployee(i).Text = ""
                mstrLastTxt(i) = ""
            End If
            chkActive(i).Value = Checked
        Next
        txtEmployee(0).Text = Trim(strName)
        mstrNotes = ""
        mstrLastNotes = ""
        For i = 2 To 3
            lstText(i).Text = ""
            mlngLstID(i) = 0
            mlngLastID(i) = 0
        Next i
        For i = 0 To 2
            mstrLastDate(i) = ""
        Next i
        mintLastchk(0) = 0
        mintLastchk(1) = 0
        If Not mblnIsNext Then
            lstText(4).Text = ""
            mlngLstID(4) = 0
            mlngLastID(4) = 0
            lstText(5).Text = ""
            mlngLstID(5) = 0
            mlngLastID(5) = 0
            chkStop(1).Value = Unchecked
            chkStop(2).Value = Unchecked
        End If
    End If
    chkStop_Click 1
    chkStop_Click 2
    mblnIsInit = False
'    SetTabIndex
End Function

Private Function IsCanDel(ByVal lngID As Long) As Boolean
    
    IsCanDel = False
    
    If UsedInAccountDaily("lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("ActivityDetail", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("ARAPInit", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("BudgetBalance", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("CostPrice", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("ItemActivity", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("PurchaseOrder", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("Salary", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("SaleOrder", "lngEmployeeID", lngID) Then Exit Function
    If CheckIDUsed("stockTaking", "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 MergeAccountDaily(mlngDEmployeeID, mlngEmployeeID, "lngEmployeeID") Then Exit Function
    If Not DisplaceActivity("ActivityDetail", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If gclsBase.ControlAccount Then
        If Not DisplaceActivity("ARAPInit", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    Else
        If Not DisplaceActivity("ARAPInit1", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    End If
    If Not MergeBudgetBalance(mlngDEmployeeID, mlngEmployeeID, "lngEmployeeID") 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("ItemActivity", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("Job", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not DisplaceActivity("PurchaseOrder", "lngEmployeeID", mlngDEmployeeID, mlngEmployeeID) Then Exit Function
    If Not MergeSalary(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("TransVoucherDetail", "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(ByVal iVer As Integer)
'    Select Case iVer
'    Case 8
'        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