frmlogin.frm

本系统可用于医院和专业体检中心的健康体检管理

VERSION 5.00
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form FrmLogin 
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000018&
   BorderStyle     =   0  'None
   Caption         =   "用户登录"
   ClientHeight    =   3270
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5925
   Icon            =   "FrmLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "FrmLogin.frx":1982
   ScaleHeight     =   3270
   ScaleWidth      =   5925
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txtPassword 
      BackColor       =   &H00FFFFC0&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   317
      IMEMode         =   3  'DISABLE
      Left            =   2160
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   1800
      Width           =   2100
   End
   Begin XPControls.XPCommandButton cmdCancel 
      Height          =   360
      Left            =   3480
      TabIndex        =   3
      Top             =   2520
      Width           =   1110
      _ExtentX        =   1958
      _ExtentY        =   635
      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 cmdOK 
      Height          =   360
      Left            =   1980
      TabIndex        =   2
      Top             =   2520
      Width           =   1110
      _ExtentX        =   1958
      _ExtentY        =   635
      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 VB.ComboBox ComboEmployee 
      BackColor       =   &H00FFFFC0&
      Height          =   300
      Left            =   2160
      TabIndex        =   0
      Top             =   1080
      Width           =   2100
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FFC0C0&
      BackStyle       =   0  'Transparent
      Caption         =   "密   码："
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   270
      Index           =   1
      Left            =   660
      TabIndex        =   5
      Top             =   2100
      Visible         =   0   'False
      Width           =   795
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FFC0C0&
      BackStyle       =   0  'Transparent
      Caption         =   "用户名："
      Height          =   270
      Index           =   0
      Left            =   780
      TabIndex        =   4
      Top             =   2460
      Visible         =   0   'False
      Width           =   795
   End
End
Attribute VB_Name = "FrmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim lngWidth As Long
Dim lngHeight As Long
Dim lngWidthStep As Long
Dim lngHeightStep As Long
Const Counts = 40

Private Sub cmdCancel_Click()
  '  LoginSucceeded = False
    Unload fMainForm
    Set fMainForm = Nothing
    
    Unload FrmLogin
    Set FrmLogin = Nothing
    
    Unload frmSplash
    Set frmSplash = Nothing
    
    End
End Sub

Private Sub cmdOK_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rs1 As New ADODB.Recordset
    
    strSQL = "SELECT * from RY_Employee WHERE NAME=" & "'" & ComboEmployee.Text & "'"
    strSQL = strSQL & " and Password='" & txtPassword.Text & "'"
    rs1.Open strSQL, GCon, adOpenStatic, adLockReadOnly
    If (rs1.RecordCount > 1) Or (rs1.RecordCount = 1) Then
        gstrManagerName = ComboEmployee.Text
'        gstrClassifyID = Rs1("RANK")
        gstrClassifyID = LongToString(rs1("JSID"), 2)
        gintManagerID = rs1("EmployeeID")
'        gstrManagerBackground = Rs1("Background")
        gstrManagerBackground = "BTTJBackGround.jpg"
        If gstrClassifyID = GManager.SystemKSYS Then
            gstrKSID = rs1("KSID")
            rs1.Close
            '获取科室名称
            strSQL = "select KSMC from SET_KSSZ WHERE KSID='" & gstrKSID & "'"
            rs1.Open strSQL, GCon, adOpenStatic, adLockReadOnly
            gstrKSMC = rs1("KSMC")
        End If
        '添加的超级医生
         If gstrClassifyID = GManager.SysTemCJYS Then
            gstrKSID = rs1("KSID")
            rs1.Close
            '获取科室名称
'            strSQL = "select KSMC from SET_KSSZ WHERE KSID='" & gstrKSID & "'"
'            rs1.Open strSQL, GCon, adOpenStatic, adLockReadOnly
'            If rs1.RecordCount >= 1 Then
'                gstrKSMC = rs1("KSMC")
'            End If
        End If
        
'        rs1.Close
        
        If gblnRegister = False Then
            gstrHospital = "未注册"
        Else
            strSQL = "select DWMC from SET_HOSPITAL"
            Set rs1 = New ADODB.Recordset
            rs1.Open strSQL, GCon, adOpenStatic, adLockOptimistic
            If Not rs1.EOF Then
                If IsNull(rs1("DWMC")) Then
                    gstrHospital = ""
                Else
                    gstrHospital = rs1("DWMC")
                End If
                rs1.Close
            End If
        End If
        
        Set rs1 = Nothing
        'LoginSucceeded = True
        Unload FrmLogin
        Set FrmLogin = Nothing
        
        Unload frmSplash
        Set frmSplash = Nothing
        
        fMainForm.MDIForm_Load
        
    Else
        MsgBox "密码不正确！请重新输入密码。密码的字母必须使用正确的大小写。请确定是否因疏忽而按下了键盘左侧的Caps Lock。", vbExclamation, "警告"
        txtPassword.SetFocus
        SendKeys "{Home}+{End}"
    End If

    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    '
End Sub

Private Sub ComboEmployee_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub Form_Load()
On Error GoTo ErrMsg
    Dim Status
    Dim i, j As Integer
    Dim sSQL As String
    Dim rsEmployee As New ADODB.Recordset
  
'    FrmLogin.Left = 2000
'    FrmLogin.Top = 1800

'    ReLogin = False
    
    Screen.MousePointer = vbArrowHourglass
    
    sSQL = "select * from RY_Employee  ORDER BY name desc "
    Set rsEmployee = New ADODB.Recordset
    rsEmployee.Open sSQL, GCon, adOpenStatic, adLockReadOnly
      
    rsEmployee.MoveFirst
    ComboEmployee.Text = "" 'rsEmployee("name")
    Do While Not rsEmployee.EOF
      ComboEmployee.AddItem rsEmployee("Name"), i
      rsEmployee.MoveNext
    Loop
    rsEmployee.Close
    
    lngWidth = Me.Width
    lngHeight = Me.Height
    lngWidthStep = Int(lngWidth / Counts)
    lngHeightStep = Int(lngHeight / Counts)
    
    Randomize
    Effect (Rnd * 4)
    
'    Timer1.Enabled = True
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Screen.MousePointer = vbDefault
End Sub

'特效
Private Sub Effect(ByVal Index As Integer)
    Dim i As Integer
'
    Select Case Index
        Case 0
            Me.Left = (Screen.Width - lngWidth) / 2
            Me.Top = (Screen.Height - lngHeight) / 2
        Case 1
            Me.Left = (Screen.Width + lngWidth) / 2
            Me.Top = (Screen.Height - lngHeight) / 2
        Case 2
            Me.Left = (Screen.Width - lngWidth) / 2
            Me.Top = (Screen.Height + lngHeight) / 2
        Case 3
            Me.Left = (Screen.Width + lngWidth) / 2
            Me.Top = (Screen.Height + lngHeight) / 2
        Case 4
            Me.Left = Screen.Width / 2
            Me.Top = Screen.Height / 2
    End Select
    
    Me.Height = 0
    Me.Width = 0
    Me.Show
    
    For i = 1 To Counts
        If Me.Width < lngWidth Then
            Me.Width = Me.Width + lngWidthStep
            If Me.Width > lngWidth Then
                Me.Width = lngWidth
            End If
        End If
        If Me.Height < lngHeight Then
            Me.Height = Me.Height + lngHeightStep
            If Me.Height > lngHeight Then
                Me.Height = lngHeight
            End If
        End If

        Select Case Index
            Case 0 '左上角
                '
            Case 1 '右上角
                Me.Left = Me.Left - lngWidthStep
            Case 2 '左下角
                Me.Top = Me.Top - lngHeightStep
            Case 3 '右下角
                Me.Left = Me.Left - lngWidthStep
                Me.Top = Me.Top - lngHeightStep
            Case 4 '中间
                Me.Left = Me.Left - lngWidthStep / 2
                Me.Top = Me.Top - lngHeightStep / 2
        End Select
'        DoEvents
    Next
    'Loop Until Me.Width = lngWidth And Me.Height = lngHeight
    
    Me.Left = (Screen.Width - lngWidth) / 2
    Me.Top = (Screen.Height - lngHeight) / 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    Timer1.Enabled = False
End Sub


Private Sub txtpassword_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdOK_Click
    End If
End Sub