add.frm

一个VB编写的校园即时广播系统,具有简单的定时广播性能

VERSION 5.00
Begin VB.Form add 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "用户资料管理"
   ClientHeight    =   3105
   ClientLeft      =   150
   ClientTop       =   375
   ClientWidth     =   3810
   Icon            =   "add.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3105
   ScaleWidth      =   3810
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton CMDCAL 
      Cancel          =   -1  'True
      Caption         =   "退出(&X)"
      Height          =   360
      Left            =   2340
      TabIndex        =   6
      ToolTipText     =   "退出本功能"
      Top             =   2700
      Width           =   1140
   End
   Begin VB.CommandButton CMDOK 
      Caption         =   "更新(&U)"
      Enabled         =   0   'False
      Height          =   360
      Left            =   255
      TabIndex        =   5
      ToolTipText     =   "更新用户资料"
      Top             =   2700
      Width           =   1140
   End
   Begin VB.Frame Frame1 
      Caption         =   "添 加 用 户"
      Height          =   2520
      Left            =   75
      TabIndex        =   7
      Top             =   120
      Width           =   3690
      Begin VB.TextBox fields 
         Height          =   300
         Index           =   1
         Left            =   600
         MaxLength       =   8
         TabIndex        =   1
         ToolTipText     =   "用户的密码"
         Top             =   645
         Width           =   1170
      End
      Begin VB.ListBox usergroup 
         Height          =   2040
         ItemData        =   "add.frx":000C
         Left            =   2550
         List            =   "add.frx":000E
         TabIndex        =   4
         ToolTipText     =   "所有用户的列表"
         Top             =   375
         Width           =   1020
      End
      Begin VB.ComboBox sexmw 
         Height          =   300
         ItemData        =   "add.frx":0010
         Left            =   600
         List            =   "add.frx":001A
         TabIndex        =   2
         Text            =   "男"
         ToolTipText     =   "用户的性别"
         Top             =   1005
         Width           =   690
      End
      Begin VB.TextBox fields 
         Height          =   915
         Index           =   2
         Left            =   600
         MaxLength       =   20
         MultiLine       =   -1  'True
         TabIndex        =   3
         ToolTipText     =   "注明用户在校职务"
         Top             =   1500
         Width           =   1890
      End
      Begin VB.TextBox fields 
         Height          =   300
         Index           =   0
         Left            =   600
         MaxLength       =   8
         TabIndex        =   0
         ToolTipText     =   "用户的姓名"
         Top             =   270
         Width           =   1830
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "密码"
         Height          =   180
         Index           =   4
         Left            =   135
         TabIndex        =   12
         Top             =   690
         Width           =   360
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "用户列表"
         Height          =   180
         Index           =   2
         Left            =   2670
         TabIndex        =   11
         Top             =   165
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "备注"
         Height          =   180
         Index           =   3
         Left            =   135
         TabIndex        =   10
         Top             =   1515
         Width           =   360
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "性别"
         Height          =   180
         Index           =   1
         Left            =   135
         TabIndex        =   9
         Top             =   1035
         Width           =   360
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "职务"
         Height          =   180
         Index           =   0
         Left            =   135
         TabIndex        =   8
         Top             =   330
         Width           =   360
      End
   End
   Begin VB.Menu m 
      Caption         =   "menu"
      Visible         =   0   'False
      Begin VB.Menu adduser 
         Caption         =   "增加用户"
      End
      Begin VB.Menu deluser 
         Caption         =   "删除用户"
      End
      Begin VB.Menu modi 
         Caption         =   "修改资料"
      End
   End
End
Attribute VB_Name = "add"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Seleu As String
Private Sub adduser_Click()
fields(0).Text = ""
fields(1).Tag = "addu"
fields(1).Text = ""
fields(2).Text = ""
CMDOK.Enabled = True
End Sub

Private Sub CMDCAL_Click()
Unload Me
End Sub

Private Sub CMDOK_Click()
Dim name As String, sex As Boolean, a As Integer
usergroup.Enabled = True
  name = fields(0).Text
    If Len(name) = 0 Then
      Exit Sub
    End If
 If sexmw.Text = "男" Then sex = True Else sex = False
   If fields(1).Tag = "addu" Then
    Server.rc.AddNew
     For a = 0 To usergroup.ListCount - 1
      If usergroup.list(a) = name Then
      CMDOK.Enabled = False
      MsgBox "该用户名已存在,用户名不能重复", vbOKOnly + vbSystemModal + vbExclamation, "错误"
      Exit Sub
      End If
     Next a
      Server.rc(0) = name
      usergroup.AddItem name
   Else
      Server.rc.Edit
      If fields(0).Tag <> name Then
      For a = 0 To usergroup.ListCount - 1
      If usergroup.list(a) = fields(0).Tag Then
      usergroup.list(a) = name
      Server.rc(0) = name
      Exit For
      End If
     Next a
   End If
    End If
    Server.rc(1) = sex       '性别
    Server.rc(2) = fields(2) '职务
    Server.rc(5) = fields(1)  '密码
    Server.rc.Update
    CMDOK.Enabled = False
    Beep
    MsgBox "修改成功", vbOKOnly
End Sub

Private Sub deluser_Click()
On Error Resume Next
If Seleu = "" Then Exit Sub
    Dim name As String, a As Integer
    name = Server.rc(0).name & " = '" & Seleu & "'"
    Server.rc.FindFirst name
    If Server.rc.NoMatch = True Then Exit Sub
        For a = 0 To usergroup.ListCount - 1
          If usergroup.list(a) = Seleu Then
            If MsgBox("真的要将用户" & Seleu & "注销吗?", vbYesNo + vbExclamation + vbSystemModal, "重要提示") = vbYes Then
              usergroup.RemoveItem a
              fields(0).Text = ""
              fields(1).Text = ""
              fields(2).Text = ""
              Server.rc.Delete
              Server.rc.Update
             Exit Sub
            End If
          End If
         Next
End Sub

Private Sub Form_Load()
With Server.rc
If .RecordCount = 0 Then Exit Sub
    .MoveFirst
     Do Until .EOF
        usergroup.AddItem Server.rc(0).Value
        .MoveNext
    DoEvents
    Loop
End With
End Sub

Private Sub list(name As String)
Dim nn As String
With Server
If .rc.RecordCount = 0 Then Exit Sub
nn = .rc(0).name & " = '" & name & "'"
.rc.FindFirst nn
   If Not .rc.NoMatch Then
        fields(0) = .rc(0).Value  '姓名
        If .rc(1) = True Then sexmw = "男" Else sexmw = "女"  '性别
        fields(1) = .rc(5).Value  '密码
        fields(2) = .rc(2).Value '职务
    Exit Sub
    End If
End With
End Sub
Private Sub modi_Click()
usergroup.Enabled = False
fields(0).Tag = Seleu
fields(1).Tag = "modi"
CMDOK.Enabled = True
list Seleu
End Sub

Private Sub usergroup_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu m, vbPopupMenuLeftAlign
If Button = 1 Then list (Seleu)
End Sub

Private Sub usergroup_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If usergroup.ListCount = 0 Then Exit Sub
Dim pos As Long, idx As Long
    Dim a As Integer
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536
    idx = SendMessage(usergroup.hwnd, LB_ITEMFROMPOINT, 0, ByVal pos)
     If idx < 65536 Then
     For a = 0 To usergroup.ListCount - 1
     If usergroup.list(a) = usergroup.list(idx) Then
     usergroup.Selected(a) = True
     If Button = 0 Then
     Seleu = usergroup.list(a)
     End If
     Exit Sub
     End If
     Next
     End If
End Sub