VB+SQL Server2000中小型医院药品管理系统 第10页

6.3主窗口界面

图6.3 主窗口界面图

Private Sub Form_Load()

LblTime.AutoSize = True

LblTime.Caption = Now

End Sub

Private Sub Menu_ManageAdd_Click()

      frmadduser.Show

End Sub

Private Sub Menu_Managechange_Click()

      frmchangepwd.Show

End Sub

Private Sub Exit_Click()

    If MsgBox("确定要退出吗？", vbYesNo + vbQuestion) = vbYes Then

        End

    Else

        Main.Show

    End If

End Sub

Private Sub Menu_EditDelete_Click()

    frmmedicmanage.Show

End Sub

Private Sub Menu_Editinto_Click()

    frmmedicmanage.Show

End Sub

Private Sub Menu_Editmedicchange_Click()

     frmmedicmanage.Show

End Sub

Private Sub Find_pingyingma_Click()

   frmmedicfind.Show

   frmmedicfind.Combo1.Text = frmmedicfind.Combo1.List(3)

End Sub

Private Sub Menu_Findname_Click()

   frmmedicfind.Show

   frmmedicfind.Combo1.Text = frmmedicfind.Combo1.List(0)

End Sub

Private Sub Menu_Findshangpinming_Click()

   frmmedicfind.Show

   frmmedicfind.Combo1.Text = frmmedicfind.Combo1.List(2)

End Sub

Private Sub Menu_Findtype_Click()

  frmmedicfind.Show

  frmmedicfind.Combo1.Text = frmmedicfind.Combo1.List(1)

  End Sub

Private Sub MenuHelp_about_Click()

    frmabout.Show

End Sub

Private Sub MenuHelp_Help_Click()

Call HtmlHelp(0, App.Path & "\help.chm", &H0, ByVal "按名称查询.htm")

End Sub

6.4添加用户表界面

图6.4添加用户表界面图

Option Explicit

Dim cnt As Integer                     '记录确定次数

Private Sub Combo1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Dim sql As String

Dim rs_add As New ADODB.Recordset

If Trim(Text1.Text) = "" Then

   MsgBox "用户名不能为空", vbOKOnly + vbExclamation, ""

   Exit Sub

   Text1.SetFocus

Else

   sql = "select * from 系统管理"

   rs_add.Open sql, conn, adOpenKeyset, adLockPessimistic

   While (rs_add.EOF = False)

        If Trim(rs_add.Fields(0)) = Trim(Text1.Text) Then

           MsgBox "已有这个用户", vbOKOnly + vbExclamation, ""

           Text1.SetFocus

           Text1.Text = ""

           Text2.Text = ""

           Text3.Text = ""

           Combo1.Text = ""

           Exit Sub

         Else

           rs_add.MoveNext

         End If

    Wend

    If Trim(Text2.Text) = "" Then

         MsgBox "密码不能为空，请重新输入！", vbOKOnly + vbExclamation, "警告"

         Text2.Text = ""

         Text2.SetFocus

         Exit Sub

    End If

    If Trim(Text2.Text) <> Trim(Text3.Text) Then

       MsgBox "两次密码不一致", vbOKOnly + vbExclamation, ""

       Text2.SetFocus

       Text2.Text = ""

       Text3.Text = ""

       Exit Sub

    ElseIf Trim(Combo1.Text) <> "system" And Trim(Combo1.Text) <> "guest" Then

       MsgBox "请选择正确的用户权限", vbOKOnly + vbExclamation, ""

       Combo1.SetFocus

       Combo1.Text = ""

       Exit Sub

    Else

       rs_add.AddNew

       rs_add.Fields(0) = Text1.Text

       rs_add.Fields(1) = Text2.Text

       rs_add.Fields(2) = Combo1.Text

       rs_add.Update

       rs_add.Close

       MsgBox "添加用户成功", vbOKOnly + vbExclamation, ""

       Unload Me

    End If

End If

End If

End Sub

Private Sub Command1_Click()

Dim sql As String

Dim rs_add As New ADODB.Recordset

If Trim(Text1.Text) = "" Then

   MsgBox "用户名不能为空", vbOKOnly + vbExclamation, ""

   Exit Sub

   Text1.SetFocus

Else

   sql = "select * from 系统管理"

   rs_add.Open sql, conn, adOpenKeyset, adLockPessimistic

   While (rs_add.EOF = False)

        If Trim(rs_add.Fields(0)) = Trim(Text1.Text) Then

           MsgBox "已有这个用户", vbOKOnly + vbExclamation, ""

           Text1.SetFocus

           Text1.Text = ""

           Text2.Text = ""

           Text3.Text = ""

           Combo1.Text = ""

           Exit Sub

         Else

           rs_add.MoveNext

         End If

    Wend

    If Trim(Text2.Text) = "" Then

         MsgBox "密码不能为空，请重新输入！", vbOKOnly + vbExclamation, "警告"

         Text2.Text = ""

         Text2.SetFocus

         Exit Sub

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10]  ... 下一页  >>