📄 frmemployeelistcard.frm
字号:
Width = 1245
End
Begin GACALENDARLibCtl.Calendar dtmEmployee
Height = 300
Index = 2
Left = 1140
OleObjectBlob = "frmEmployeeListCard.frx":010A
TabIndex = 23
Top = 2430
Width = 1245
End
Begin VB.Label lblNote
Caption = "个人所得税"
Height = 195
Index = 11
Left = 2700
TabIndex = 38
Top = 2130
Width = 915
End
Begin VB.Label lblNote
Caption = "职员编号(&C)"
Height = 240
Index = 0
Left = 150
TabIndex = 0
Top = 300
Width = 1095
End
Begin VB.Label lblNote
Caption = "职务(&M)"
Height = 210
Index = 6
Left = 150
TabIndex = 12
Top = 1350
Width = 915
End
Begin VB.Label lblNote
Caption = "所属部门(&E)"
Height = 300
Index = 3
Left = 2580
TabIndex = 6
Top = 660
Width = 1005
End
Begin VB.Label lblNote
Caption = "家庭地址(&A)"
Height = 300
Index = 16
Left = 2580
TabIndex = 31
Top = 3210
Width = 1005
End
Begin VB.Label lblNote
Caption = "职员姓名(&N)"
Height = 300
Index = 2
Left = 2580
TabIndex = 2
Top = 300
Width = 1005
End
Begin VB.Label lblNote
Caption = "出生日期(&T)"
Height = 300
Index = 9
Left = 150
TabIndex = 16
Top = 1710
Width = 1005
End
Begin VB.Label lblNote
Caption = "文化程度(&U)"
Height = 300
Index = 5
Left = 2580
TabIndex = 10
Top = 1020
Width = 1005
End
Begin VB.Label lblNote
Caption = "职员类型(&L)"
Height = 210
Index = 4
Left = 150
TabIndex = 8
Top = 1005
Width = 1065
End
Begin VB.Label lblNote
Caption = "银行帐号(&K)"
Height = 300
Index = 7
Left = 2580
TabIndex = 14
Top = 1380
Width = 1035
End
Begin VB.Label lblNote
Caption = "入职日期(&I)"
Height = 300
Index = 10
Left = 150
TabIndex = 20
Top = 2055
Width = 1005
End
Begin VB.Label lblNote
Caption = "离职日期(&Q)"
Height = 300
Index = 12
Left = 150
TabIndex = 22
Top = 2430
Width = 1005
End
Begin VB.Label lblNote
Caption = "住宅电话(&H)"
Height = 300
Index = 13
Left = 150
TabIndex = 24
Top = 2805
Width = 1005
End
Begin VB.Label lblNote
Caption = "办公电话(&O)"
Height = 300
Index = 8
Left = 2580
TabIndex = 18
Top = 1740
Width = 1005
End
Begin VB.Label lblNote
Caption = "性别(&X)"
Height = 195
Index = 1
Left = 150
TabIndex = 4
Top = 675
Width = 675
End
Begin VB.Label lblNote
Caption = "邮政编码(&P)"
Height = 300
Index = 15
Left = 150
TabIndex = 29
Top = 3180
Width = 1005
End
Begin VB.Label lblNote
Caption = "扣税标准(&Z)"
Height = 225
Index = 14
Left = 2700
TabIndex = 27
Top = 2760
Width = 1215
End
End
Attribute VB_Name = "frmEmployeeListCard"
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 mlngLastID(4) As Long
Private mstrLastTxt(6) As String
Private mintLastchk(1) As Integer
Private mstrLastCbo As String
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(4) As Long
Private mblnIsFirst(4) As Boolean
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Public Property Get getID()
getID = mlngEmployeeID
End Property
Public Function DelCard(ByVal lngID As Long) As Boolean
Dim strSql As String, strEmp As String
Dim recTemp As rdoResultset
If lngID = mlngEmployeeID And frmEmployeeList.IsShowCard(1) Then
ShowMsg 0, "不能删除正在修改的职员！", vbExclamation + MB_TASKMODAL, "删除职员"
Show
Exit Function
End If
DelCard = False
strSql = "SELECT * FROM Employee WHERE lngEmployeeID=" & lngID
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
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 0, "职员“" & strEmp & "”已经发生业务,不能删除！", vbExclamation + MB_TASKMODAL, "删除职员"
Exit Function
End If
If ShowMsg(0, "你确实要删除职员“" & strEmp & "”吗？", vbQuestion + vbYesNo + MB_TASKMODAL, _
"删除职员") = 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) As Long
If IsContinue Then Exit Function
mlngEmployeeID = 0
mblnIsChanged = True
mblnIsNew = True
cmdOK(2).Default = True
InitCard strName
Show intModal
AddCard = mlngEmployeeID
Refresh
ZOrder 0
Unload MsgForm
End Function
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
Optional strEmployee As String)
Dim strMess As String
If IsContinue Then Exit Sub
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 = "修改职员"
cmdOK(0).Default = True
InitCard
SendKeys "%{C}"
Show intModal
Refresh
ZOrder 0
End If
Unload MsgForm
End Sub
'检查录入 1--正确 -1--编码重复 -2--名称重复
Private Function CheckCode() 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, rdOpenForwardOnly)
If Not recEmployee.EOF Then
If recEmployee!strEmployeeCode = txtEmployee(0).Text Then
mlngDEmployeeID = recEmployee!lngEmployeeID
CheckCode = -1
ElseIf recEmployee!strEmployeeName = txtEmployee(1).Text Then
CheckCode = -2
End If
Else
CheckCode = 1
End If
recEmployee.Close
End Function
Private Sub cboSex_Click()
If mblnIsInit Then Exit Sub
mblnIsChanged = True
End Sub
Private Sub cboSex_GotFocus()
cboSex.Tag = cboSex.Text
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
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 = ""
mlngLstID(4) = 0
lstText(4).BackColor = &H80000004
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() As Boolean
CheckDate = False
If dtmEmployee(0).Text > dtmEmployee(1).Text And dtmEmployee(1).Text <> "" Then
ShowMsg hwnd, "出生日期不能大于入职日期！", vbExclamation + MB_TASKMODAL, Caption
dtmEmployee(0).Text = mstrLastDate(0)
dtmEmployee(0).SetFocus
ElseIf dtmEmployee(0).Text > dtmEmployee(2).Text And dtmEmployee(2).Text <> "" Then
ShowMsg hwnd, "出生日期不能大于离职日期！", vbExclamation + MB_TASKMODAL, Caption
dtmEmployee(0).Text = mstrLastDate(0)
dtmEmployee(0).SetFocus
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -