frmlogin.frm

社区医疗管理系统 用vb开发的简单社区卫生组织用的管理系统

VERSION 5.00
Begin VB.Form frmlogin 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "系统登陆"
   ClientHeight    =   4515
   ClientLeft      =   45
   ClientTop       =   300
   ClientWidth     =   6705
   Icon            =   "frmlogin.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4515
   ScaleWidth      =   6705
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      Height          =   4575
      Left            =   0
      Picture         =   "frmlogin.frx":058A
      ScaleHeight     =   4515
      ScaleWidth      =   6675
      TabIndex        =   0
      Top             =   0
      Width           =   6735
      Begin VB.TextBox Txtpwd 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   3120
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   2160
         Width           =   2295
      End
      Begin VB.TextBox Txtuser 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   3120
         TabIndex        =   1
         Top             =   1440
         Width           =   2295
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Height          =   495
         Left            =   9120
         MouseIcon       =   "frmlogin.frx":A558
         MousePointer    =   99  'Custom
         TabIndex        =   5
         Top             =   240
         Width           =   495
      End
      Begin VB.Label Lblquxiao 
         BackStyle       =   0  'Transparent
         Height          =   735
         Left            =   3840
         MouseIcon       =   "frmlogin.frx":A6AA
         MousePointer    =   99  'Custom
         TabIndex        =   4
         ToolTipText     =   "取消登录"
         Top             =   3360
         Width           =   1815
      End
      Begin VB.Label lbldenglu 
         BackStyle       =   0  'Transparent
         Height          =   735
         Left            =   1320
         MouseIcon       =   "frmlogin.frx":A7FC
         MousePointer    =   99  'Custom
         TabIndex        =   3
         ToolTipText     =   "用户登录"
         Top             =   3360
         Width           =   1815
      End
   End
End
Attribute VB_Name = "frmlogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/18
'描    述：社区医疗点数据管理系统 Ver 1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
Dim cnt As Integer                     '记录确定次数
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const RGN_XOR = 3
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Type RECT
  left As Long
  top As Long
  right As Long
  bottom As Long
End Type
Dim Xs As Long

Function CreatePictureform()
  On Error Resume Next
  Dim hRgn As Long, hRect As RECT, hTempRgn As Long, tColour As Long, OldScaleMode As Integer, AbsoluteX As Long, AbsoluteY As Long
  Dim Color As Long, Hrect1 As RECT
  Dim xx As Long, yy As Long
  Dim rtn As Long
  Me.Picture = Me.Picture1
  Me.Width = Me.Picture1.Width
  Me.Height = Me.Picture1.Height
  OldScaleMode = Me.ScaleMode
  Me.AutoRedraw = True
  Me.ScaleMode = 3
  Color = vbWhite
  rtn = GetWindowRect(Me.hWnd, hRect)
  hRgn = CreateRectRgn(0, 0, hRect.right, hRect.bottom)
  For AbsoluteX = 0 To Me.ScaleWidth
    For AbsoluteY = 0 To Me.ScaleHeight
      tColour = GetPixel(Me.hdc, AbsoluteX, AbsoluteY)
      If tColour = Color Then
        hTempRgn = CreateRectRgn(AbsoluteX, AbsoluteY, AbsoluteX + 1, AbsoluteY + 1)
        rtn = CombineRgn(hRgn, hRgn, hTempRgn, RGN_XOR)
        rtn = DeleteObject(hTempRgn)
      End If
    Next AbsoluteY
  Next AbsoluteX
  rtn = SetWindowRgn(Me.hWnd, hRgn, True)
  DeleteObject hRgn
  Me.ScaleMode = OldScaleMode
  If Err Then
    MsgBox Error, 16, Err
  End If
End Function

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
    Dim ReturnVal As Long
    Xs = ReleaseCapture()
    ReturnVal = SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  End If
End Sub
Private Sub Form_Load()
Dim connectionstring As String
connectionstring = "provider=Microsoft.Jet.oledb.4.0;" & _
                   "Data Source=D:\医疗点数据管理系统\medic.mdb"
conn.Open connectionstring
cnt = 0
End Sub

Private Sub lbldenglu_Click()
Dim sql As String
Dim rs_login As New ADODB.Recordset
If Trim(Txtuser.Text) = "" Then            '判断输入的用户名是否为空
   MsgBox "没有这个用户", 64, "用户登录"
   Txtuser.Text = ""
   Txtpwd.Text = ""
   Txtuser.SetFocus
Else
   sql = "select * from 系统管理 where 用户名='" & Txtuser.Text & "'"
   rs_login.Open sql, conn, adOpenKeyset, adLockPessimistic
   If rs_login.EOF = True Then
      MsgBox "没有这个用户", 64, "用户登录"
       Txtuser.Text = ""
       Txtpwd.Text = ""
      Txtuser.SetFocus
   Else                                  '检验密码是否正确
      If Trim(rs_login.Fields(1)) = Trim(Txtpwd.Text) And Trim(rs_login.Fields(2)) = "system" Then
          userID = Txtuser.Text
          userpow = rs_login.Fields(2)
          rs_login.Close
          Unload Me
          Main.Show
      ElseIf Trim(rs_login.Fields(1)) = Trim(Txtpwd.Text) And Trim(rs_login.Fields(2)) = "guest" Then
          userpow = rs_login.Fields(2)
          rs_login.Close
          Unload Me
          Main.Show
          Main.Menu_Edit.Enabled = False
          Main.Menu_ManageAdd.Enabled = False
      Else
         MsgBox "密码不正确", 64, "用户登录"
          Txtpwd.Text = ""
         Txtpwd.SetFocus
      End If
   End If
End If
cnt = cnt + 1
If cnt = 3 Then
      MsgBox "错误太多，您无权使用！" & vbCrLf & "系统会自动退出，再见！", 16, "提示"
      Unload Me
End If
Exit Sub
End Sub

Private Sub Txtpwd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
     lbldenglu_Click
End If
End Sub
Private Sub Lblquxiao_Click()
End
End Sub