📄 formemployeechange.frm
字号:
BackColor = &H80000004&
BackStyle = 0 'Transparent
Caption = "移动电话："
Height = 195
Left = 270
TabIndex = 24
Top = 3810
Width = 900
End
Begin VB.Label Label9
AutoSize = -1 'True
BackColor = &H80000004&
BackStyle = 0 'Transparent
Caption = "家庭住址："
Height = 195
Left = 270
TabIndex = 23
Top = 4275
Width = 900
End
Begin VB.Label Label6
AutoSize = -1 'True
BackColor = &H80000004&
BackStyle = 0 'Transparent
Caption = "角色："
Height = 195
Left = 660
TabIndex = 22
Top = 2910
Width = 540
End
End
Begin VB.Frame Frame3
BackColor = &H00D3DABC&
Height = 885
Left = 3705
TabIndex = 0
Top = 6060
Width = 5775
Begin XPControls.XPCommandButton CommandDelete
Height = 375
Left = 3621
TabIndex = 1
Top = 330
Width = 855
_ExtentX = 1508
_ExtentY = 661
Caption = "删 除"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton CommandAdd
Height = 375
Left = 270
TabIndex = 2
Top = 330
Width = 855
_ExtentX = 1508
_ExtentY = 661
Caption = "增 加"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton CommandExit
Cancel = -1 'True
Height = 375
Left = 4740
TabIndex = 3
Top = 330
Width = 855
_ExtentX = 1508
_ExtentY = 661
Caption = "退 出"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton CommandOK
Height = 375
Left = 2504
TabIndex = 4
Top = 330
Width = 855
_ExtentX = 1508
_ExtentY = 661
Enabled = 0 'False
Caption = "保 存"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton cmdModify
Height = 375
Left = 1387
TabIndex = 5
Top = 330
Width = 855
_ExtentX = 1508
_ExtentY = 661
Caption = "修 改"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
End
Attribute VB_Name = "FormEmployeeChange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Dim rsTemp As ADODB.Recordset
'Dim SaveDirect As String
'Dim rsAddEmployee As New ADODB.Recordset
Dim MAXID As Integer
Dim menuOperation As OperationType
Private Sub cmbClassify_Click()
'决定是否显示科室
If cmbClassify.ItemData(cmbClassify.ListIndex) = Val(GManager.SystemKSYS) Then
fraKeShi.Visible = True
Else
fraKeShi.Visible = False
'超级医生
If cmbClassify.ItemData(cmbClassify.ListIndex) = Val(GManager.SysTemCJYS) Then
fraKeShi.Visible = True
Else
fraKeShi.Visible = False
End If
End If
End Sub
Private Sub cmbClassify_KeyPress(KeyAscii As Integer)
EnterToTab KeyAscii
End Sub
Private Sub CmbJS_Click()
'决定是否显示科室
If LongToString(CmbJS.ItemData(CmbJS.ListIndex), 2) = GManager.SystemKSYS Then '如果是科室医生
fraKeShi.Tag = ""
fraKeShi.Visible = True
Else
fraKeShi.Visible = False
If LongToString(CmbJS.ItemData(CmbJS.ListIndex), 2) = GManager.SysTemCJYS Then
fraKeShi.Tag = "CJYS"
fraKeShi.Visible = True
Else
fraKeShi.Visible = False
End If
End If
End Sub
Private Sub cmdBrowser_Click()
Dim strFileName As String
strFileName = GetFileName(Me.CommonDialog1, _
"位图(*.bmp),JPEG(*.jpg)|*.bmp;*.jpg|GIF图像(*.gif)|*.gif|图标(*.ico)|*.ico", _
"选择签名图片文件", , READFILE)
If strFileName <> "" Then
Set imgSign.PICTURE = LoadPicture(strFileName)
End If
End Sub
Private Sub cmdModify_Click()
CommandAdd.Enabled = False
CommandDelete.Enabled = False
cmdModify.Enabled = False
CommandOK.Enabled = True
lstKeShi.Enabled = True
menuOperation = Modify
EnableInput True
TextName.SetFocus
End Sub
Private Sub CommandAdd_Click()
Dim strSQL As String
Dim rstemp As ADODB.Recordset
'清空所有输入项
ClearAllInput
CommandAdd.Enabled = False
CommandDelete.Enabled = False
cmdModify.Enabled = False
CommandOK.Enabled = True
'先取最大EmployeeID号
strSQL = "SELECT MAX(EmployeeID) as EMID FROM RY_Employee"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
If IsNull(rstemp("EMID")) Then
MAXID = 1
Else
MAXID = rstemp("EMID") + 1
End If
rstemp.Close
'清除签名图片框
imgSign.PICTURE = LoadPicture() '清除签名
menuOperation = Add
EnableInput True
'设置焦点
TextName.SetFocus
' SaveDirect = "ADD"
End Sub
Private Sub CommandDelete_Click()
Dim intID As Integer
Dim strSQL As String
'是否选择了用户
If lvwEmployee.SelectedItem Is Nothing Then
MsgBox "请选择您要删除的用户！", vbInformation, "提示"
Exit Sub
End If
If MsgBox("该操作不可恢复！确定删除用户“" & TextName.Text & "”吗", _
vbQuestion + vbYesNo, "确认") = vbNo Then Exit Sub
'获取选择用户的ID
intID = Val(Mid(lvwEmployee.SelectedItem.Key, 2))
'是否当前用户
If intID = gintManagerID Then
'这个判断同时可以保证至少有一个系统管理员存在！
MsgBox "不能删除自己！", vbExclamation, "警告"
Exit Sub
End If
'构建删除语句
strSQL = "delete from RY_Employee" _
& " where EmployeeID=" & intID
GCon.Execute strSQL
'删除在左侧列表中的显示
intID = lvwEmployee.SelectedItem.Index
lvwEmployee.ListItems.Remove intID
If lvwEmployee.ListItems.Count >= 1 Then
If intID = 1 Then
Set lvwEmployee.SelectedItem = lvwEmployee.ListItems(intID)
Else
Set lvwEmployee.SelectedItem = lvwEmployee.ListItems(intID - 1)
End If
lvwEmployee_Click
End If
' DisplayEmployee
End Sub
Private Sub CommandExit_Click()
Unload FormEmployeeChange
Set FormEmployeeChange = Nothing
End Sub
Private Sub CommandOK_Click()
On Error GoTo ErrMsg
Dim strSQL As String
Dim Status
Dim i As Integer, intIndex As Integer
Dim rsAddEmployee As ADODB.Recordset
Dim rstemp As ADODB.Recordset
Dim rsGetRows As ADODB.Recordset
Dim rsChange As ADODB.Recordset
Dim itmTemp As ListItem
Dim strTempFile As String
Dim ksTemp As String
Me.MousePointer = vbHourglass
'校验用户名
If TextName.Text = "" Then
MsgBox "请输入用户名！", vbInformation, "提示"
TextName.SetFocus
GoTo ExitLab
End If
'校验角色
If CmbJS.Text = "" Then
MsgBox "请选择角色！", vbInformation, "提示"
CmbJS.SetFocus
GoTo ExitLab
End If
' '是否输入密码
' If TextPassword.Text = "" Then
' MsgBox "请输入密码！", vbInformation, "提示"
' TextPassword.SetFocus
' GoTo ExitLab
' End If
'
' '密码长度是否超过六位
' If Len(TextPassword.Text) < 6 Then
' MsgBox "为了安全性，请输入至少六位的密码！", vbInformation, "提示"
' TextPassword.SetFocus
' GoTo ExitLab
' End If
' '是否选择了职务
' If ComboZhiWu.Text = "" Then
' MsgBox "请选择用户“" & TextName.Text & "”的职务！", vbInformation, "提示"
' ComboZhiWu.SetFocus
' GoTo ExitLab
' End If
If menuOperation = Add Then
'****************************************************************
'添加用户
'****************************************************************
If MsgBox("确定添加此用户吗", vbQuestion + vbOKCancel, "是否确定") = vbOK Then
'检查是否已经存在该用户
strSQL = "select Count(*) from RY_Employee" _
& " where Name='" & TextName.Text & "'"
Set rsGetRows = New ADODB.Recordset
rsGetRows.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
If rsGetRows(0) >= 1 Then
MsgBox "该用户已经存在，请核对后重新输入！", vbInformation, "提示"
TextName.SetFocus
GoTo ExitLab
End If
rsGetRows.Close
Set rsAddEmployee = New ADODB.Recordset
strSQL = "select * from RY_Employee" _
& " where 1=0"
rsAddEmployee.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
rsAddEmployee.AddNew
rsAddEmployee("Name") = TextName.Text
If (DTPBorn.Value <> "") Then
rsAddEmployee("Born") = DTPBorn.Value
Else
rsAddEmployee("Born") = Null
End If
rsAddEmployee("ZhiWu") = ComboZhiWu.Text 'LongToString(ComboZhiWu.ItemData(ComboZhiWu.ListIndex), 2)
'*****************************************************
'管理类别
'*****************************************************
' rsAddEmployee("Rank") = LongToString(cmbClassify.ItemData(cmbClassify.ListIndex), 2)
' If cmbClassify.ItemData(cmbClassify.ListIndex) = Val(GManager.SystemKSYS) Then
rsAddEmployee("Rank") = LongToString(CmbJS.ItemData(CmbJS.ListIndex), 2)
If CmbJS.ItemData(CmbJS.ListIndex) = Val(GManager.SystemKSYS) Then
'首先判断用户是否选择了科室
With lstKeShi
intIndex = -1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
intIndex = i
Exit For
End If
Next
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -