frmoperator.frm

在线图书馆系统 包括VB程序设计的后台与ASP的网页

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FrmOperator 
   Caption         =   "操作员管理"
   ClientHeight    =   5910
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7425
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   5910
   ScaleWidth      =   7425
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame3 
      Height          =   2415
      Left            =   4440
      TabIndex        =   12
      Top             =   3240
      Width           =   2655
      Begin VB.CommandButton cmdCancel 
         Caption         =   "取消(&C)"
         Height          =   540
         Left            =   1440
         TabIndex        =   18
         Top             =   980
         Width           =   975
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "增加(&A)"
         Height          =   540
         Left            =   240
         TabIndex        =   17
         Top             =   280
         Width           =   975
      End
      Begin VB.CommandButton cmdClose 
         Caption         =   "关闭(&E)"
         Height          =   540
         Left            =   1440
         TabIndex        =   16
         Top             =   1680
         Width           =   975
      End
      Begin VB.CommandButton cmdSave 
         Caption         =   "保存(&S)"
         Height          =   540
         Left            =   240
         TabIndex        =   15
         Top             =   980
         Width           =   975
      End
      Begin VB.CommandButton cmdDelete 
         Caption         =   "删除(&D)"
         Height          =   540
         Left            =   240
         TabIndex        =   14
         Top             =   1680
         Width           =   975
      End
      Begin VB.CommandButton CmdUpdate 
         Caption         =   "修改(&U)"
         Height          =   540
         Left            =   1440
         TabIndex        =   13
         Top             =   280
         Width           =   975
      End
   End
   Begin MSFlexGridLib.MSFlexGrid Grid1 
      Height          =   3135
      Left            =   240
      TabIndex        =   4
      Top             =   120
      Width           =   6975
      _ExtentX        =   12303
      _ExtentY        =   5530
      _Version        =   393216
      Cols            =   6
      MousePointer    =   4
      MouseIcon       =   "FrmOperator.frx":0000
   End
   Begin VB.Frame Frame1 
      Height          =   2415
      Left            =   240
      TabIndex        =   0
      Top             =   3240
      Width           =   3975
      Begin VB.ComboBox CombPopedom 
         Height          =   300
         ItemData        =   "FrmOperator.frx":0452
         Left            =   2760
         List            =   "FrmOperator.frx":045C
         TabIndex        =   19
         Top             =   1500
         Width           =   975
      End
      Begin VB.TextBox txtBirthday 
         DataField       =   "Adddate"
         Height          =   285
         Left            =   1320
         TabIndex        =   10
         Top             =   1960
         Width           =   2415
      End
      Begin VB.TextBox txtName 
         Height          =   285
         Left            =   1320
         TabIndex        =   9
         Top             =   1102
         Width           =   2415
      End
      Begin VB.TextBox txtID 
         DataField       =   "ReaderID"
         Height          =   285
         Left            =   1320
         TabIndex        =   8
         Top             =   260
         Width           =   2415
      End
      Begin VB.ComboBox CombSex 
         Height          =   300
         ItemData        =   "FrmOperator.frx":0470
         Left            =   1320
         List            =   "FrmOperator.frx":047A
         TabIndex        =   7
         Top             =   1500
         Width           =   735
      End
      Begin VB.TextBox txtPass 
         Height          =   285
         IMEMode         =   3  'DISABLE
         Left            =   1320
         PasswordChar    =   "*"
         TabIndex        =   6
         Top             =   681
         Width           =   2415
      End
      Begin VB.Label lblLabels 
         Caption         =   "权限"
         Height          =   180
         Index           =   1
         Left            =   2280
         TabIndex        =   20
         Top             =   1560
         Width           =   390
      End
      Begin VB.Label lblLabels 
         Caption         =   "操作员编码"
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   11
         Top             =   390
         Width           =   1035
      End
      Begin VB.Label lblLabels 
         Caption         =   "口令"
         Height          =   180
         Index           =   2
         Left            =   360
         TabIndex        =   5
         Top             =   780
         Width           =   750
      End
      Begin VB.Label lblLabels 
         Caption         =   "姓名"
         Height          =   180
         Index           =   3
         Left            =   360
         TabIndex        =   3
         Top             =   1170
         Width           =   750
      End
      Begin VB.Label lblLabels 
         Caption         =   "性别"
         Height          =   180
         Index           =   4
         Left            =   360
         TabIndex        =   2
         Top             =   1560
         Width           =   750
      End
      Begin VB.Label lblLabels 
         Caption         =   "出生日期"
         Height          =   180
         Index           =   10
         Left            =   360
         TabIndex        =   1
         Top             =   1950
         Width           =   750
      End
   End
End
Attribute VB_Name = "FrmOperator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mAddNew As Boolean
Dim ResultCount As Integer
Dim Cn As New ADODB.Connection
Dim MyAdoRS As New ADODB.Recordset
Dim SQL As String
Dim MsgStr As String
Dim MaxDay() As Integer
Dim pd As Boolean   '修改口令标志

Private Sub cmdAdd_Click()
    Call TxtEdit(False)
    Call TxtClear
    mAddNew = True
    txtID.SetFocus
End Sub

Private Sub cmdCancel_Click()
    MyAdoRS.Close
    Set MyAdoRS = ExecuteSQL(SQL, MsgStr)
     '显示所有记录
    DisplayKeySetGrid MyAdoRS, Grid1, 1
    TxtClear
     Call TxtEdit(True)
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdDelete_Click()
    If txtID.Text = "" Then
        MsgBox "请选择删除记录!"
        Exit Sub
    Else
        If MsgBox("确定删除所选记录吗?", vbYesNo) = vbYes Then
            Sqls = "delete from operators where OperatorId='" & txtID.Text & "'"
            Call ExecuteSQL(Sqls, MsgStr)
        End If
        '刷新显示
         MyAdoRS.Close
         Set MyAdoRS = ExecuteSQL(SQL, MsgStr)
          '显示所有记录
         DisplayKeySetGrid MyAdoRS, Grid1, 1
    End If
        
    
End Sub

Private Sub cmdSave_Click()
    Dim rs As ADODB.Recordset
    Dim Sqls As String
    If Not IsDate(txtBirthday.Text) Then
        MsgBox "出生日期输入错误, 请重新输入!"
        txtBirthday.SelStart = 0
        txtBirthday.SelLength = Len(txtBirthday.Text)
        txtBirthday.SetFocus
        Exit Sub
    End If
    If txtPass.Text = "" Then
        If MsgBox("确认口令为空吗?", vbYesNo) = vbNo Then
            If MsgBox("确认口令为默认口令吗?", vbYesNo) = vbYes Then
                '默认口令为操作员ID
                txtPass.Text = txtID.Text
            Else
                txtPass.SetFocus
            End If
        End If
    End If
    If mAddNew = True Then
        '查询操作员编号是否重复
        Sqls = "select OperatorId from operators where OperatorId='" & txtID.Text & "'"
        Set rs = ExecuteSQL(Sqls, MsgStr)
        If Not rs.EOF Then
            MsgBox ("操作员ID重复,请重新输入!")
            Exit Sub
        Else
            Sqls = "insert into operators(OperatorId,Password,Name,Sex,BornDate,Popedom  )"
            Sqls = Sqls & " values('" & txtID.Text & "','" & txtPass.Text & "','" & txtName.Text & "','"
            Sqls = Sqls & CombSex.Text & "','" & txtBirthday.Text & "','" & CombPopedom.Text & "')"
            ExecuteSQL Sqls, MsgStr
        End If
    Else
       pd = False
       If txtPass.Text = "" Then
            If MsgBox("修改原口令为空口令吗?", vbYesNo) = vbNo Then
                Sqls = "update  operators set Name='" & txtName.Text & "',"
                Sqls = Sqls & "Sex='" & CombSex.Text & "',BornDate='" & txtBirthday.Text & "',Popedom='" & CombPopedom.Text & "'"
                Sqls = Sqls & " where OperatorId='" & txtID.Text & "'"
            Else
                pd = True
            End If
      End If
      If pd = True Then
            Sqls = "update  operators set Password='" & txtPass.Text & "',Name='" & txtName.Text & "',"
            Sqls = Sqls & "Sex='" & CombSex.Text & "',BornDate='" & txtBirthday.Text & "',Popedom='" & CombPopedom.Text & "'"
            Sqls = Sqls & " where OperatorId='" & txtID.Text & "'"
       End If
        ExecuteSQL Sqls, MsgStr
    End If
    '刷新显示
    MyAdoRS.Close
    Set MyAdoRS = ExecuteSQL(SQL, MsgStr)
     '显示所有记录
    DisplayKeySetGrid MyAdoRS, Grid1, 1
     Call TxtEdit(True)
     TxtClear
End Sub

Private Sub cmdUpdate_Click()
    If txtID.Text = "" Then
        MsgBox "请选择要修改的记录!"
        Exit Sub
    Else
        Call TxtEdit(False)
        '读者ID不能修改
        txtID.Locked = True
        mAddNew = False
    End If
End Sub

Private Sub Form_Load()
    Dim rs As ADODB.Recordset
    Dim k As String
    
    
    '设置鼠标形状
    MousePointer = vbHourglass
    
     '打开SQL语句指定的数据集
    SQL = "select OperatorId 操作员编码, Name 姓名,Sex 性别,"
    SQL = SQL & "convert(char(4),year(BornDate))+'-'+rtrim(convert(char(2),month(BornDate)))+'-'+rtrim(convert(char(2),day(BornDate))) "
    SQL = SQL & " 出生日期,Popedom 权限 from operators "
    
    Set MyAdoRS = ExecuteSQL(SQL, MsgStr)
     '显示记录
    DisplayKeySetGrid MyAdoRS, Grid1, 1
    Call TxtEdit(True)
        '恢复鼠标形状
    MousePointer = vbDefault
End Sub

Private Sub Grid1_Click()
    Dim i As Integer
    Dim s As String
    
    Grid1.Col = 1
    txtID.Text = Grid1.Text
    Grid1.Col = 2
    txtName.Text = Grid1.Text
    Grid1.Col = 3
    CombSex.Text = Grid1.Text
    Grid1.Col = 4
    txtBirthday.Text = Grid1.Text
    Grid1.Col = 5
    CombPopedom.Text = Grid1.Text
End Sub

Sub TxtClear()
    txtID.Text = ""
    CombSex.Text = ""
    txtName.Text = ""
    txtBirthday.Text = ""
    CombPopedom.Text = ""
    txtPass.Text = ""
End Sub

Sub TxtEdit(flag As Boolean)
    txtPass.Locked = flag
    txtID.Locked = flag
    txtName.Locked = flag
    CombSex.Locked = flag
    txtBirthday.Locked = flag
    CombPopedom.Locked = flag
    CmdUpdate.Enabled = flag
    cmdDelete.Enabled = flag
    cmdAdd.Enabled = flag
    cmdCancel.Enabled = Not flag
    cmdSave.Enabled = Not flag
    cmdClose.Enabled = flag
    
End Sub

Private Sub DisplayKeySetGrid(rs As ADODB.Recordset, Grid As MSFlexGrid, nDirection As Integer)
    '定义字段对象等
    Dim fld As ADODB.Field
    Dim nForward As Integer
    Dim nReverse As Integer
    On Error Resume Next
    
    '设置显示方式常数
    nForward = 1
    nReverse = 2
    
    '设置列表框
    Grid.Cols = rs.Fields.Count + 1
    rs.MoveLast
    Grid.Rows = rs.RecordCount + 1
    Grid.Row = 0
    Grid.Col = 0
   ' Grid.MousePointer = flexDefault
    Grid.ColWidth(0) = 200
    Grid.Col = 1
    Grid.FixedRows = 1
    Grid.FixedCols = 1
    Grid.Clear
    
    '设置表头
    For Each fld In rs.Fields
        If rs.EOF = False Then
            Grid.ColWidth(Grid.Col) = TextWidth(String(fld.ActualSize + 10, "a"))
        End If
        Grid.ColAlignment(Grid.Col) = 4
        Grid.Text = fld.Name
        If Grid.Col <= rs.Fields.Count Then
            Grid.Col = Grid.Col + 1
        End If
    Next fld
    
    '向前方式
    If nDirection = nForward Then
        rs.MoveFirst
        '遍历
        Do Until rs.EOF
            '设置在列表框中的位置
            Grid.Row = Grid.Row + 1
            Grid.Col = 1
            '遍历所有字段
            For Each fld In rs.Fields
                Grid.Text = fld.Value
                If Grid.Col <= rs.Fields.Count Then
                    Grid.Col = Grid.Col + 1
                End If
            Next fld
            '移动到下一条记录
            rs.MoveNext
        Loop
    '向后方式
    Else
        rs.MoveLast
        '遍历
        Do Until rs.BOF
            '设置在列表框中的位置
            Grid.Row = Grid.Row + 1
            Grid.Col = 1
            '遍历所有字段
            For Each fld In rs.Fields
                Grid.Text = fld.Value
                If Grid.Col <= rs.Fields.Count Then
                    Grid.Col = Grid.Col + 1
                End If
            Next fld
            '移动到前一条记录
            rs.MovePrevious
        Loop
    End If
   
End Sub