📄 frmedit.frm
字号:
Width = 360
End
Begin VB.Line Line
BorderColor = &H00808080&
Index = 0
X1 = 240
X2 = 9600
Y1 = 4800
Y2 = 4800
End
Begin VB.Line Line
BorderColor = &H00FFFFFF&
Index = 1
X1 = 240
X2 = 9600
Y1 = 4815
Y2 = 4815
End
End
Begin VB.CommandButton cmdEdit
Caption = "添加(&A)"
Height = 350
Index = 0
Left = 4020
Style = 1 'Graphical
TabIndex = 10
Top = 6300
Width = 1095
End
Begin VB.Frame fraEdit
Caption = "当前记录"
Height = 675
Index = 2
Left = 60
TabIndex = 5
Top = 60
Width = 9855
Begin VB.TextBox TxtPersonal
Height = 300
Index = 21
Left = 4440
TabIndex = 11
Top = 240
Width = 1815
End
Begin VB.ComboBox cboManage
Height = 300
Left = 1200
Style = 2 'Dropdown List
TabIndex = 9
Top = 240
Width = 1815
End
Begin VB.TextBox TxtPersonal
Height = 300
Index = 18
Left = 7680
TabIndex = 0
Top = 240
Width = 1815
End
Begin VB.Label lblCboManage
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "隶属部门"
Height = 180
Left = 360
TabIndex = 8
Top = 300
Width = 720
End
Begin VB.Label lblTxtPersonal
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "姓名"
Height = 180
Index = 18
Left = 7200
TabIndex = 7
Top = 300
Width = 360
End
Begin VB.Label lblTxtPersonal
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "员工编号"
Height = 180
Index = 21
Left = 3600
TabIndex = 6
Top = 300
Width = 720
End
End
Begin VB.CommandButton cmdEdit
Caption = "关闭(&C)"
Default = -1 'True
Height = 350
Index = 4
Left = 8820
TabIndex = 4
Top = 6300
Width = 1095
End
Begin VB.CommandButton cmdEdit
Caption = "删除(&D)"
Height = 350
Index = 3
Left = 6420
TabIndex = 3
Top = 6300
Width = 1095
End
Begin VB.CommandButton cmdEdit
Caption = "取消(&C)"
Enabled = 0 'False
Height = 350
Index = 2
Left = 7620
TabIndex = 2
Top = 6300
Width = 1095
End
Begin VB.CommandButton cmdEdit
Caption = "保存(&S)"
Height = 350
Index = 1
Left = 5220
Style = 1 'Graphical
TabIndex = 1
Top = 6300
Width = 1095
End
End
Attribute VB_Name = "frmEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoCallLink As New ADODB.Recordset '连接选择框中显示的数据
Dim intCount As Integer
Dim strLabel As String
Dim bAddNew As Boolean
Dim strName As String
Dim strCboName As String
Dim autoCount As Integer
Dim strTempManage As String
Dim intID() As Integer
Private Sub cboManage_Click()
strCboName = cboManage.Text
End Sub
Private Sub cboPersonal_GotFocus(Index As Integer)
Dim strNewPersonal As String
If Index = 0 Then Exit Sub
On Error GoTo errNext
With adoCallLink
intCount = 0
If Len(Trim(cboPersonal(Index).Text)) > 0 Then strNewPersonal = cboPersonal(Index).Text
cboPersonal(Index).Clear
cboPersonal(Index).Text = strNewPersonal
If .State = adStateOpen Then .Close
strLabel = Trim(lblCboPersonal(Index).Caption)
.Open "select * from " & strLabel, adoConn, adOpenDynamic, adLockPessimistic, adCmdText
Do Until .EOF
strLabel = Trim(lblCboPersonal(Index).Caption)
cboPersonal(Index).AddItem .Fields(strLabel), intCount
.MoveNext
intCount = intCount + 1
Loop
.Close
End With
Exit Sub
errNext:
MsgBox "错误：" & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbExclamation, "运行错误"
End Sub
Public Sub subClear()
For autoCount = 0 To 5
txtDate(autoCount).Text = ""
Next
For autoCount = 0 To 12
cboPersonal(autoCount).Text = ""
Next
For autoCount = 0 To 22
TxtPersonal(autoCount).Text = ""
Next
For autoCount = 0 To 3
txtCorp(autoCount).Text = ""
Next
imgPersonal.Picture = Nothing
imgPersonal.Height = 1275
imgPersonal.Width = 980
End Sub
Public Sub cmdEdit_Click(Index As Integer)
On Error GoTo errNext
Select Case Index
Case 0: '新增
bAddNew = True
Call subClear
cmdEdit(1).Enabled = True
cmdEdit(1).SetFocus
cmdEdit(2).Enabled = True
cmdEdit(0).Enabled = False
cmdEdit(3).Enabled = False
Case 1: '保存
Dim strNumber As String '员工编号
strNumber = Trim(TxtPersonal(21).Text)
If Len(Trim(cboManage.Text)) = 0 Then MsgBox "隶属部门不能为空,请重新输入!", vbCritical, App.Title: cboManage.SetFocus: Exit Sub
If Len(strNumber) = 0 Then MsgBox "员工编号不能为空,请重新输入!", vbCritical, App.Title: TxtPersonal(21).SetFocus: Exit Sub
If Len(Trim(TxtPersonal(18).Text)) = 0 Then MsgBox "员工姓名不能为空,请重新输入!", vbCritical, App.Title: TxtPersonal(18).SetFocus: Exit Sub
With adoCallLink
If .State = adStateOpen Then .Close
.Open "select * from 员工详细资料 where 员工编号='" & Trim(TxtPersonal(21).Text) & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If bAddNew = True Then
If .EOF = False Then MsgBox "此员工编号已在存在,请输入新的编号!", vbCritical, App.Title: TxtPersonal(21).Text = strString: TxtPersonal(21).SetFocus: Exit Sub '如果发现此编号已在别处存在，则发出错误!
.AddNew
Else
If .EOF = False And strString <> Trim(TxtPersonal(21).Text) Then MsgBox "此员工编号已在存在,请输入新的编号!", vbCritical, App.Title: TxtPersonal(21).Text = strString: TxtPersonal(21).SetFocus: Exit Sub '如果发现此编号已在别处存在，则发出错误!
.Close
.Open "select * from 员工详细资料 where 员工编号='" & strString & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
End If
'.Fields("隶属部门") = Mid(cboManage.Text, 1, .Fields("隶属部门").DefinedSize)
.Fields("隶属部门") = intID(cboManage.ListIndex)
For intCount = 0 To 5
.Fields(lblDate(intCount).Caption) = IIf(Len(Trim(txtDate(intCount).Text)) <> 0, txtDate(intCount).Text, Null)
Next
For intCount = 0 To 12
.Fields(lblCboPersonal(intCount).Caption) = IIf(Len(Trim(cboPersonal(intCount).Text)) <> 0, Mid(cboPersonal(intCount).Text, 1, .Fields(lblCboPersonal(intCount).Caption).DefinedSize), Null)
Next
For intCount = 0 To 22
.Fields(lblTxtPersonal(intCount).Caption) = IIf(Len(Trim(TxtPersonal(intCount).Text)) <> 0, Mid(TxtPersonal(intCount).Text, 1, .Fields(lblTxtPersonal(intCount).Caption).DefinedSize), Null)
Next
For intCount = 0 To 1
.Fields(lblCorp(intCount).Caption) = IIf(Len(Trim(txtCorp(intCount).Text)) <> 0, Trim(txtCorp(intCount).Text), Null)
Next
.Fields("照片路径") = strName
.Update
strString = strNumber
.Close
.Open "select * from v员工详细资料 where 隶属部门='" & cboManage.Text & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
intCount = 0
If .EOF = False Then
.MoveLast
intCount = .RecordCount
End If
Call frmInfo.ManageLoad(0)
If strTempManage <> Trim(cboManage.Text) Or bAddNew = True Then
frmInfo.tvwManage.Nodes(cboManage.ListIndex + 2).Text = cboManage.Text & "(" & intCount & ")"
End If
If bAddNew = True Then
intPalCount(1) = intPalCount(1) + 1
frmInfo.staInfo.Panels(3).Text = "公司员工数:" & intPalCount(1) & "个"
bAddNew = False
End If
End With
cmdEdit(0).Enabled = True
cmdEdit(2).Enabled = False
cmdEdit(3).Enabled = True
Call frmInfo.ManageLoad(0)
MsgBox "保存成功!", vbInformation, App.Title
Case 2: '取消
Call subClear
Call subLoad
If bAddNew = True Then
bAddNew = False
cmdEdit(0).Enabled = True
cmdEdit(0).SetFocus
End If
cmdEdit(2).Enabled = False
Case 3: '删除
If MsgBox("确认要删除吗?", vbInformation + vbYesNo, App.Title) = vbYes Then
With adoCallLink
If .State = adStateOpen Then .Close
.Open "select 员工编号,隶属部门 from 员工详细资料 where 员工编号='" & strString & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
For intCount = 0 To cboManage.ListCount
If cboManage.List(intCount) = .Fields("隶属部门") & "" Then
cboManage.ListIndex = intCount
End If
Next
.Delete
cmdEdit(0).Enabled = True
cmdEdit(1).Enabled = False
cmdEdit(3).Enabled = False
.Close
.Open "select * from 员工详细资料 where 隶属部门='" & cboManage.Text & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
intCount = 0
If .EOF = False Then
.MoveLast
intCount = .RecordCount
End If
Call subClear
frmInfo.tvwManage.Nodes(cboManage.ListIndex + 2).Text = cboManage.Text & "(" & intCount & ")"
intPalCount(1) = intPalCount(1) - 1
frmInfo.staInfo.Panels(3).Text = "公司员工数:" & intPalCount(1) & "个"
Call frmInfo.ManageLoad(0)
strString = ""
MsgBox "删除成功!", vbInformation, App.Title
Else
MsgBox "发生错误,在数据库中未找该编号的员工!", vbInformation + vbYesNo, App.Title
End If
End With
End If
Case 4: '关闭
Unload Me
End Select
Exit Sub
errNext:
MsgBox "错误：" & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbExclamation, "运行错误"
End Sub
Private Sub cmdPersonal_Click(Index As Integer)
If Index = 0 Then
frmInfo.cdgMain.DialogTitle = "选择员工照片"
frmInfo.cdgMain.Filter = "bmp位图(*.bmp)|*.bmp|ico图标(*.ico)|*.ico|JPEG图片(*.jpg)|*.jpg|GIF图片(*.gif)|*.gif|"
frmInfo.cdgMain.ShowOpen
strName = frmInfo.cdgMain.FileName
If Len(strName) = 0 Then Exit Sub
imgPersonal.Picture = LoadPicture(strName)
Else
strName = ""
imgPersonal.Picture = Nothing
imgPersonal.Height = 1275
imgPersonal.Width = 980
End If
End Sub
Private Sub DTPDate_Change(Index As Integer)
txtDate(Index).Text = DTPDate(Index).Year & "-" & DTPDate(Index).Month & "-" & DTPDate(Index).Day
End Sub
Private Sub Form_Load()
frmInfo.Enabled = False
On Error Resume Next
strCboName = ""
intCount = 0
With adoCallLink
If .State = adStateOpen Then .Close
.Open "select * from 隶属部门 order by 层次,id", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
.MoveLast
ReDim intID(.RecordCount - 1)
.MoveFirst
End If
Do Until .EOF
cboManage.AddItem .Fields("隶属部门"), intCount
intID(intCount) = .Fields("id")
.MoveNext
intCount = intCount + 1
Loop
If Len(strTvwName) > 0 Then cboManage.Text = strTvwName
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set adoCallLink = Nothing
frmInfo.Enabled = True
End Sub
Public Sub subLoad()
On Error GoTo errNext
frmInfo.Enabled = False
With adoCallLink '载入用户的内容
If .State = adStateOpen Then .Close
.Open "select * from v员工详细资料 where 员工编号='" & strString & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
cmdEdit(0).Enabled = True
cmdEdit(1).Enabled = Not .EOF
cmdEdit(3).Enabled = Not .EOF
If .EOF = False Then
For intCount = 0 To 5
txtDate(intCount).Text = .Fields(lblDate(intCount).Caption) & ""
Next
For intCount = 0 To 12
cboPersonal(intCount).Text = .Fields(lblCboPersonal(intCount).Caption) & ""
Next
For intCount = 0 To cboManage.ListCount
If cboManage.List(intCount) = .Fields("隶属部门") & "" Then
cboManage.ListIndex = intCount
End If
Next
strTempManage = .Fields("隶属部门") & ""
For intCount = 0 To 22
TxtPersonal(intCount) = .Fields(lblTxtPersonal(intCount).Caption) & ""
Next
For intCount = 0 To 1
txtCorp(intCount).Text = .Fields(lblCorp(intCount).Caption) & ""
Next
imgPersonal.Picture = Nothing
imgPersonal.Height = 1275
imgPersonal.Width = 980
imgPersonal.Picture = LoadPicture(Trim(.Fields("照片路径")) & "")
End If
.Close
End With
Exit Sub
errNext:
MsgBox "错误：" & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbExclamation, "运行错误"
End Sub
Private Sub txtCorp_LostFocus(Index As Integer)
If IsNumeric(txtCorp(Index).Text) = False Then txtCorp(Index).Text = ""
End Sub
Private Sub txtDate_LostFocus(Index As Integer)
If IsDate(txtDate(Index).Text) = False Then txtDate(Index).Text = ""
End Sub
Private Sub TabStrip1_Click()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -