frmbase_pwd.frm

医院管理方面的例子

VERSION 5.00
Begin VB.Form FrmBase_Pwd 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFC0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "请输入口令"
   ClientHeight    =   3315
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6120
   ControlBox      =   0   'False
   FillStyle       =   7  'Diagonal Cross
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "FrmBase_Pwd.frx":0000
   ScaleHeight     =   3315
   ScaleWidth      =   6120
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox TxtPwd 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   405
      IMEMode         =   3  'DISABLE
      Left            =   2880
      MaxLength       =   6
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   1680
      Width           =   2235
   End
   Begin VB.ComboBox CmbUserName 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   405
      Left            =   2880
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   1200
      Width           =   2235
   End
   Begin VB.Frame FrameTmp 
      Height          =   30
      Index           =   1
      Left            =   1320
      TabIndex        =   7
      Top             =   1020
      Width           =   4485
   End
   Begin VB.Frame FrameTmp 
      Height          =   30
      Index           =   0
      Left            =   1320
      TabIndex        =   6
      Top             =   2250
      Width           =   4485
   End
   Begin VB.CommandButton CmdCancel 
      BackColor       =   &H00FFC0C0&
      Caption         =   "取消[&C]"
      Height          =   435
      Left            =   3630
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   2400
      Width           =   1485
   End
   Begin VB.CommandButton CmdOk 
      BackColor       =   &H00FFC0C0&
      Caption         =   "确定[&O]"
      Height          =   435
      Left            =   2070
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   2400
      Width           =   1485
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "乳腺普健康档案"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   360
      Left            =   1980
      TabIndex        =   8
      Top             =   450
      Width           =   2640
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户口令"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   240
      Left            =   1770
      TabIndex        =   5
      Top             =   1755
      Width           =   1035
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用 户 名"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   240
      Left            =   1770
      TabIndex        =   4
      Top             =   1275
      Width           =   1050
   End
End
Attribute VB_Name = "FrmBase_Pwd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CmbUserName_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Trim(CmbUserName) <> "" Then TxtPwd.SetFocus
End Sub

Private Sub Form_Load()
    Dim AdoRsPwd    As ADODB.Recordset
    Set AdoRsPwd = New ADODB.Recordset
    AdoRsPwd.Open "SELECT userid, UserName FROM aqgl_yh WHERE UseFlag='1' ORDER BY userid DESC ", PcnnHisDb, adOpenKeyset
    Call ProcAddCmbItem(CmbUserName, AdoRsPwd)
    AdoRsPwd.Close: Set AdoRsPwd = Nothing
End Sub

Private Sub CmdCancel_Click()
    Unload Me
End Sub

Private Sub CmdOk_Click()
    Dim AdoRsPwd    As ADODB.Recordset
    Set AdoRsPwd = New ADODB.Recordset
    
    If Trim(CmbUserName) = "" Then MsgBox "请选择用户名。", vbInformation, "": CmbUserName.SetFocus: Exit Sub
    AdoRsPwd.Open "SELECT userid,username FROM aqgl_yh WHERE UserID='" + CStr(CmbUserName.ItemData(CmbUserName.ListIndex)) + "' AND UserPwd='" + Trim(TxtPwd) + "' ORDER BY userid", PcnnHisDb, adOpenDynamic
    If AdoRsPwd.EOF Or AdoRsPwd.BOF Then
        AdoRsPwd.Close: Set AdoRsPwd = Nothing
        MsgBox "口令错误，请重新输入!", vbInformation, ""
        TxtPwd = ""
        TxtPwd.SetFocus
    Else
        PStrUserID = IIf(IsNull(AdoRsPwd.Fields(0)), "", AdoRsPwd.Fields(0))
        PStrUserName = IIf(IsNull(AdoRsPwd.Fields(1)), "", AdoRsPwd.Fields(1))
        AdoRsPwd.Close: Set AdoRsPwd = Nothing
                
        Unload Me
        FrmBase_Main.Show
    End If
End Sub

Private Sub TxtPwd_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Trim(CmbUserName) <> "" Then CmdOk.SetFocus
End Sub