frmempcardnew.frm

金算盘软件代码

         Top             =   1545
         Width           =   1065
      End
      Begin VB.Label lblNote 
         Caption         =   "职员姓名(&N)"
         Height          =   300
         Index           =   2
         Left            =   210
         TabIndex        =   2
         Top             =   825
         Width           =   1005
      End
      Begin VB.Label lblNote 
         Caption         =   "家庭地址(&A)"
         Height          =   300
         Index           =   16
         Left            =   210
         TabIndex        =   19
         Top             =   2610
         Width           =   1005
      End
      Begin VB.Label lblNote 
         Caption         =   "所属部门(&E)"
         Height          =   300
         Index           =   3
         Left            =   210
         TabIndex        =   7
         Top             =   1185
         Width           =   1005
      End
      Begin VB.Label lblNote 
         Caption         =   "职务(&M)"
         Height          =   210
         Index           =   6
         Left            =   3090
         TabIndex        =   13
         Top             =   1905
         Width           =   645
      End
      Begin VB.Label lblNote 
         Caption         =   "职员编号(&C)"
         Height          =   240
         Index           =   0
         Left            =   210
         TabIndex        =   0
         Top             =   510
         Width           =   1095
      End
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   1
      Left            =   5730
      Style           =   1  'Graphical
      TabIndex        =   31
      Tag             =   "1002"
      Top             =   810
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   0
      Left            =   5730
      Style           =   1  'Graphical
      TabIndex        =   30
      Tag             =   "1001"
      Top             =   420
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   2
      Left            =   5730
      Style           =   1  'Graphical
      TabIndex        =   32
      Tag             =   "1009"
      Top             =   1185
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   4
      Left            =   5730
      Style           =   1  'Graphical
      TabIndex        =   33
      Tag             =   "1013"
      Top             =   1590
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkStop 
      Caption         =   "停用"
      Height          =   225
      Index           =   0
      Left            =   5700
      TabIndex        =   34
      Top             =   3690
      Width           =   735
   End
End
Attribute VB_Name = "frmEmployeeCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                                            '
'                 功能:       完成职员的增、删、改。                                     '
'                 卡片接口:             EditCard 参数: lngID 记录的ID号                      '
'                 作用:                           LNGID为零是增加记录、其它为编辑记录        '
'                                       DelCard 参数: lngID 记录的ID号                       '
'                 作用:                           删除ID号为LNGID的记录                      '
'                 作者：     冉升                                                                           '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Option Explicit
Option Compare Text
'初始化的数据
Private mblnIsInit As Boolean
Private mblnIsList As Boolean
Private mblnIsExist As Boolean
Private mblnIsNext As Boolean
Private mblnIsRefer As Boolean
Private mlngLastID(5) As Long
Private mstrLastTxt(7) As String
Private mintLastchk(1) As Integer
Private mstrLastDate(2) As String
Private mstrLastNotes As String
Private mblnIsChanged As Boolean
Private mblnIsNew As Boolean
Private mlngDEmployeeID As Long
Private mlngEmployeeID As Long
Private mstrNotes As String
'Private mstrLastCode As String
'Private mstrLastName As String
Private mstrEmployee As String
Private mlngLstID(5) As Long
Private mblnIsFirst(5) As Boolean
'直接增加职员
Public Function AddEmployee(ByVal strEmployee As String) As Integer
    Dim blnIsInActive As Boolean, blnIsMale As Boolean
    Dim blnIsBank As Boolean, blnIsPersonTax As Boolean
    Dim blnAccount As Boolean, blnAR As Boolean
    Dim blnAP As Boolean, blnCash As Boolean, i As Integer
    Dim blnPurchase As Boolean, blnSale As Boolean
    Dim blnStock As Boolean, blnEntrust As Boolean
    Dim lngDepartmentID As Long, lngEmployeeTypeID As Long
    Dim lngEducationID As Long, lngPersonTaxTypeID As Long
    Dim lngBankID As Long, lngTitleID As Long
    Dim strBankCode As String, strIndate As String
    Dim strOutdate As String, strAddress As String
    Dim strPostalCode As String, strOfficePhone As String
    Dim strHomePhone As String, strBirthdate As String
    Dim strCardNo As String, strTemp As String
    Dim strEmployeeCode As String, strEmployeeName As String
    
    On Error GoTo ErrHandle
    AddEmployee = 0
    If Not GetString(strEmployee, strEmployeeCode, 1) Then Exit Function
    If Not GetString(strEmployee, strEmployeeName, 2) Then Exit Function
    If Not GetString(strEmployee, strTemp, 3) Then Exit Function
    blnIsMale = (strTemp = "1")
    If Not GetString(strEmployee, strTemp, 4) Then Exit Function
    lngEmployeeTypeID = CLng(strTemp)
    If Not GetString(strEmployee, strTemp, 5) Then Exit Function
    lngDepartmentID = CLng(strTemp)
    If Not GetString(strEmployee, strTemp, 6) Then Exit Function
    lngEducationID = CLng(strTemp)
    If Not GetString(strEmployee, strTemp, 7) Then Exit Function
    blnIsPersonTax = (strTemp = "1")
    If Not GetString(strEmployee, strTemp, 8) Then Exit Function
    lngPersonTaxTypeID = CLng(strTemp)
    If Not GetString(strEmployee, strTemp, 9) Then Exit Function
    blnIsBank = (strTemp = "1")
    If Not GetString(strEmployee, strTemp, 10) Then Exit Function
    lngBankID = CLng(strTemp)
    If Not GetString(strEmployee, strBankCode, 11) Then Exit Function
    If Not GetString(strEmployee, strIndate, 12) Then Exit Function
    If Not GetString(strEmployee, strOutdate, 13) Then Exit Function
    If Not GetString(strEmployee, strTemp, 14) Then Exit Function
    lngTitleID = CLng(strTemp)
    If Not GetString(strEmployee, strAddress, 15) Then Exit Function
    If Not GetString(strEmployee, strPostalCode, 16) Then Exit Function
    If Not GetString(strEmployee, strOfficePhone, 17) Then Exit Function
    If Not GetString(strEmployee, strHomePhone, 18) Then Exit Function
    If Not GetString(strEmployee, strBirthdate, 19) Then Exit Function
    If Not GetString(strEmployee, mstrNotes, 20) Then Exit Function
    If Not GetString(strEmployee, strCardNo, 21) Then Exit Function
    If Not GetString(strEmployee, strTemp, 22) Then Exit Function
    blnIsInActive = (strTemp = "1")
    For i = 23 To 30
        If Not GetString(strEmployee, strTemp, i) Then Exit Function
        chkActive(i - 23).Value = strTemp
    Next i
    
    If strEmployeeCode = "" Or strEmployeeName = "" Then Exit Function
    If ItemIsExist("EmployeeType", "lngEmployeeTypeID", lngEmployeeTypeID) Then
        mlngLstID(1) = lngEmployeeTypeID
    Else
        Exit Function
    End If
    If ItemIsExist("Department", "lngDepartmentID", lngDepartmentID) Then
        mlngLstID(0) = lngDepartmentID
    Else
        Exit Function
    End If
    If ItemIsExist("Education", "lngEducationID", lngEducationID) Then
        mlngLstID(2) = lngEducationID
    Else
        mlngLstID(2) = 0
    End If
    If ItemIsExist("Title", "lngTitleID", lngTitleID) Then
        mlngLstID(3) = lngTitleID
    Else
        mlngLstID(3) = 0
    End If
    If ItemIsExist("PersonTaxType", "lngPersonTaxTypeID", lngPersonTaxTypeID) Then
        mlngLstID(4) = lngPersonTaxTypeID
    Else
        mlngLstID(4) = 0
    End If
    If ItemIsExist("Bank", "lngBankID", lngBankID) Then
        mlngLstID(5) = lngBankID
    Else
        mlngLstID(5) = 0
    End If
    optSex(0).Value = blnIsMale
    optSex(1).Value = Not blnIsMale
    dtmEmployee(0).Text = Trim(strBirthdate)
    dtmEmployee(1).Text = Trim(strIndate)
    dtmEmployee(2).Text = Trim(strOutdate)
    chkStop(1).Value = IIf(blnIsPersonTax, 1, 0)
    chkStop(2).Value = IIf(blnIsBank, 1, 0)
    txtEmployee(0).Text = strEmployeeCode
    txtEmployee(1).Text = strEmployeeName
    txtEmployee(2).Text = strBankCode
    txtEmployee(3).Text = strOfficePhone
    txtEmployee(4).Text = strHomePhone
    txtEmployee(5).Text = strPostalCode
    txtEmployee(6).Text = strAddress
    txtEmployee(7).Text = strCardNo
    chkStop(0).Value = IIf(blnIsInActive, 1, 0)
    mblnIsNew = True
    If Not SaveCard(True) Then Exit Function
    AddEmployee = 1
ErrHandle:
End Function

Public Property Get getID()
    getID = mlngEmployeeID
End Property

Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim strSql As String, strEmp As String
    Dim recTemp As rdoResultset
    
'    If lngID = mlngEmployeeID And frmEmployeeList.IsShowCard(1) Then
'        ShowMsg lnghWnd, "不能删除正在修改的职员！", vbExclamation + MB_TASKMODAL, "删除职员"
'        Show vbModal
'        Exit Function
'    End If
    DelCard = False
    strSql = "SELECT * FROM Employee WHERE lngEmployeeID=" & lngID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.EOF Then
        recTemp.Close
        Exit Function
    Else
        strEmp = Trim(recTemp!strEmployeeCode) & " " & Trim(recTemp!strEmployeeName)
    End If
    recTemp.Close
    If Not IsCanDel(lngID) Then
        ShowMsg lnghWnd, "职员“" & strEmp & "”已经发生业务,不能删除！", vbExclamation + MB_TASKMODAL, "删除职员"
        Exit Function
    End If
    If ShowMsg(lnghWnd, "你确实要删除职员“" & strEmp & "”吗？", vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, _
        "删除职员") = vbNo Then Exit Function
    strSql = "DELETE FROM Employee WHERE lngEmployeeID=" & lngID
    DelCard = gclsBase.ExecSQL(strSql)
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgEmployee
End Function

Public Function AddCard(Optional strName As String = "", _
    Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mlngEmployeeID = 0
    mblnIsChanged = True
    mblnIsNew = True
    mblnIsList = IsList
    InitCard strName
    Show intModal
    AddCard = mlngEmployeeID
End Function

Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strEmployee As String)
    Dim strMess As String
    
    If Not CheckIDUsed("Employee", "lngEmployeeID", lngID) Then
        If Trim(strEmployee) <> "" Then
            strMess = "“" & strEmployee & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "职员不存在,不能进行修改！", vbExclamation + MB_TASKMODAL, "修改职员"
        Unload Me
    Else
        mlngEmployeeID = lngID
        mblnIsChanged = False
        mblnIsNew = False
        Caption = "修改职员"
        InitCard
'        SendKeys "%{C}"
        Show intModal
    End If
End Sub
'检查录入 1--正确  -1--编码重复  -2--名称重复
Private Function CheckCode(ByRef strName As String) As Integer
    Dim recEmployee As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM Employee WHERE (strEmployeeCode='" & txtEmployee(0).Text _
        & "' Or (strEmployeeName='" & txtEmployee(1).Text & "' AND lngDepartmentID=" _
        & mlngLstID(0) & ")) AND lngEmployeeID <>" & IIf(mblnIsNew, 0, mlngEmployeeID)
    Set recEmployee = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recEmployee.EOF Then
        If recEmployee!strEmployeeCode = txtEmployee(0).Text Then
            mlngDEmployeeID = recEmployee!lngEmployeeID
            strName = recEmployee!strEmployeeCode & " " & recEmployee!strEmployeeName
            CheckCode = -1
        ElseIf recEmployee!strEmployeeName = txtEmployee(1).Text Then
            CheckCode = -2
        End If
    Else
        CheckCode = 1
    End If
    recEmployee.Close
End Function