📄 frmlogout.frm
字号:
VERSION 5.00
Object = "{806F1F89-D431-4F37-A387-2868CC03DCA8}#48.0#0"; "GetData.ocx"
Begin VB.Form frmLogout
BackColor = &H00F1E7DA&
BorderStyle = 1 'Fixed Single
Caption = "翰佳科技CT影像工作站"
ClientHeight = 3840
ClientLeft = 45
ClientTop = 330
ClientWidth = 5895
ControlBox = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmLogout.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3840
ScaleWidth = 5895
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
BackColor = &H00F1E7DA&
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1515
Left = 60
TabIndex = 0
Top = 1770
Width = 5790
Begin VB.ComboBox cmbUsers
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
ItemData = "frmLogout.frx":6852
Left = 1875
List = "frmLogout.frx":6854
Style = 2 'Dropdown List
TabIndex = 2
Top = 360
Width = 2910
End
Begin VB.TextBox txtPassword
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
IMEMode = 3 'DISABLE
Left = 1875
MaxLength = 50
PasswordChar = "*"
TabIndex = 1
Top = 885
Width = 2925
End
Begin VB.Label lblLabels
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "用 户"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Index = 0
Left = 975
TabIndex = 4
Top = 390
Width = 870
End
Begin VB.Label lblLabels
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "密 码"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Index = 1
Left = 975
TabIndex = 3
Top = 930
Width = 900
End
End
Begin GetData.XPB btnOk
Height = 375
Left = 2370
TabIndex = 5
Top = 3375
Width = 1410
_ExtentX = 2487
_ExtentY = 661
Caption = "确 定"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin GetData.XPB btnCancel
Height = 375
Left = 45
TabIndex = 6
Top = 3420
Visible = 0 'False
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "取消"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin GetData.XPB btnExit
Height = 420
Left = 4350
TabIndex = 7
Top = 3375
Width = 1410
_ExtentX = 2487
_ExtentY = 741
Caption = "退出系统"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Image Image1
Height = 1695
Left = 45
Picture = "frmLogout.frx":6856
Stretch = -1 'True
Top = 0
Width = 5790
End
End
Attribute VB_Name = "frmLogout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------------------------------------------------
'文件：frmLogout.frm
'作者：刘辉
'时间：2008-09-04
'说明：用户注册后的登录窗体
'------------------------------------------------------------------------------------
Option Explicit
Dim iCurDepartIndex As Integer
Dim rsDepartment As New ADODB.Recordset
'取消按钮事件
Private Sub btnCancel_Click(Shifit As Integer)
On Error GoTo ErrHandler
Unload Me
Exit Sub
ErrHandler:
End Sub
Private Sub btnColorSet_Click(Shifit As Integer)
On Error Resume Next
'frmHLS.Show vbModal
End Sub
Private Sub btnExit_Click(Shifit As Integer)
End
End Sub
'确定按钮事件
Private Sub btnOk_Click(Shifit As Integer)
On Error GoTo ErrHandler
If Len((cmbUsers.Text)) <= 0 Then
MsgBox "请选择用户!", vbExclamation, "用户登录"
Exit Sub
End If
If Len((txtPassword.Text)) <= 0 Then
MsgBox "密码错误, 请重新输入!", vbExclamation, "用户登录"
txtPassword.SetFocus
Exit Sub
End If
If stringCheck(Trim(txtPassword.Text)) = False Then
Exit Sub
End If
Dim rsUser As New ADODB.Recordset
Dim sqlExecute As String
sqlExecute = "SELECT ID, Name,DOCTOR_NAME,UserPassword, UserPower FROM Doctor WHERE Name = '" _
& Trim(cmbUsers.Text) & "'"
If myConn.State <> adStateClosed Then
myConn.Close
End If
myConn.Open modGlobalDbConnect.GetConnectionString
If myConn.State = adStateClosed Then
MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
Exit Sub
End If
rsUser.Open sqlExecute, myConn
If rsUser.RecordCount <= 0 Then
MsgBox "该用户名不存在, 请重新选择", vbExclamation, "用户登录"
rsUser.Close
txtPassword.Text = ""
myConn.Close
Set myConn = Nothing
Exit Sub
End If
If rsUser.Fields("UserPassword") = txtPassword.Text Then
If Not IsNull(rsUser.Fields("ID")) Then
USER_ID = Trim(rsUser.Fields("ID"))
End If
If Not IsNull(rsUser.Fields("Name")) Then
USER_NAME = Trim(rsUser.Fields("Name"))
End If
If Not IsNull(rsUser.Fields("DOCTOR_Name")) Then
USER_DISPLAY_NAME = Trim(rsUser.Fields("DOCTOR_Name"))
End If
'判断用户权限，如果是审核医师，则以普通医师权限登陆
If Not IsNull(rsUser.Fields("UserPower")) And _
rsUser.Fields("UserPower") <> POWER_AUDITING_DOCT Then
USER_POWER = Trim(rsUser.Fields("UserPower"))
Else
USER_POWER = POWER_COMMON_USER
End If
frmMdiMain.lblUser.Caption = USER_DISPLAY_NAME
'院长，系统管理员为0，部门领导为5，审核医生7，普通用户为10
'USER_POWER
If USER_POWER = POWER_ADMIN Then
frmMdiMain.lblIdentity.Caption = POWERNAME_ADMIN
ElseIf USER_POWER = POWER_DEPARTMENT_LEADER Then
'显示用户管理 刘辉2008-08-09-06-22：30 修改
frmSystemMaintain.tabSystemMaintain.TabVisible(1) = True
frmMdiMain.lblIdentity.Caption = POWERNAME_DEPARTMENT_LEADER
ElseIf USER_POWER = POWER_AUDITING_DOCT Then
'不显示用户管理
frmSystemMaintain.tabSystemMaintain.TabVisible(1) = False
frmMdiMain.lblIdentity.Caption = POWERNAME_AUDITING_DOCT
Else
'不显示用户管理
frmSystemMaintain.tabSystemMaintain.TabVisible(1) = False
frmMdiMain.lblIdentity.Caption = POWERNAME_COMMON_USER
End If
' frmRecordEdit.lblUser.Caption = USER_DISPLAY_NAME
'院长，系统管理员为0，部门领导为5，审核医生7，普通用户为10
'USER_POWER
'If USER_POWER = POWER_ADMIN Then
' frmRecordEdit.lblIdentity.Caption = POWERNAME_ADMIN
'ElseIf USER_POWER = POWER_DEPARTMENT_LEADER Then
' frmRecordEdit.lblIdentity.Caption = POWERNAME_DEPARTMENT_LEADER
'ElseIf USER_POWER = POWER_AUDITING_DOCT Then
' frmRecordEdit.lblIdentity.Caption = POWERNAME_AUDITING_DOCT
'Else
' frmRecordEdit.lblIdentity.Caption = POWERNAME_COMMON_USER
'End If
'*******************************************************************************
Unload Me
IF_LOGON = True
frmCheckList.SetFocus
Else
MsgBox "用户名或密码错误,请重新输入!", vbExclamation, "用户登录"
txtPassword.Text = ""
txtPassword.SetFocus
End If
Exit Sub
ErrHandler:
If MsgBox(Err.Description + " 您确定要退出吗?", vbExclamation + vbYesNo, "出错") = vbYes Then
Unload Me
Else
Unload Me
frmLogout.Show vbModal
End If
End Sub
'-----------------------确定按钮事件-----------------------------------------------------------------------------
Private Sub cmbUsers_Click()
On Error GoTo ErrHandler
txtPassword.Text = ""
txtPassword.SetFocus
Exit Sub
ErrHandler:
'msgbox "",vbExclamation,"提示"
End Sub
Private Sub Form_Load() '登陆系统
On Error GoTo ErrHandler
If DEPARTMENT_ID < 0 Then
MsgBox "部门信息获取失败, 请退出系统重新登录!", vbExclamation, "登录"
Exit Sub
End If
Dim bRet As Boolean
bRet = InitCmbUsers(DEPARTMENT_ID)
If bRet = False Then
MsgBox "用户列表初始化失败, 可能是网络连接错误所致, 请退出系统重新登录!", vbExclamation, "登录"
Exit Sub
End If
Dim dirc As String
Exit Sub
ErrHandler:
MsgBox "数据库连接失败, 原因：" + Err.Description + "请与系统管理员联系!", vbExclamation, "提示"
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo ErrHandler
Exit Sub
ErrHandler:
End Sub
'根据部门ID初始化用户COMBOBOX
Private Function InitCmbUsers(ByVal DepartmentID As Long) As Boolean
On Error GoTo ErrHandler
Dim strSql As String
Dim rsCmbUsers As New ADODB.Recordset
strSql = "SELECT ID,NAME FROM Doctor WHERE DepartmentId = '" + CStr(DepartmentID) + "'" + " AND ISDELETE ='否'"
myConn.CursorLocation = adUseClient
If myConn.State <> adStateClosed Then
myConn.Close
End If
myConn.Open modGlobalDbConnect.GetConnectionString
If myConn.State = adStateClosed Then
MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
Exit Function
End If
rsCmbUsers.Open strSql, myConn
If rsCmbUsers.RecordCount <= 0 Then
InitCmbUsers = False
Exit Function
End If
Dim i As Integer
cmbUsers.Clear
For i = 0 To rsCmbUsers.RecordCount - 1
cmbUsers.AddItem rsCmbUsers.Fields("Name")
rsCmbUsers.MoveNext
Next
If cmbUsers.ListCount > 0 Then
cmbUsers.ListIndex = 0
End If
InitCmbUsers = True
Exit Function
ErrHandler:
Debug.Print Err.Description
InitCmbUsers = False
End Function
Private Sub Form_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
'回车键
If KeyAscii = 13 Then
btnOk_Click 0
End If
Exit Sub
ErrHandler:
End Sub
Private Sub txtPassword_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
'回车键
If KeyAscii = 13 Then
btnOk_Click 0
End If
Exit Sub
ErrHandler:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -