frmreadermanage.frm

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

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 tj As String
Dim MaxDay() As Integer

Private Sub cmdAdd_Click()
    Call TxtEdit(False)
    Call TxtClear
    mAddNew = True
    txtID.SetFocus
    txtAdd.Text = Format(Now, "YYYY-MM-DD")
End Sub

Private Sub cmdCancel_Click()
    MyAdoRS.Close
    Set MyAdoRS = ExecuteSQL(SQL & tj, MsgStr)
     '显示所有记录
    DisplayKeySetGrid MyAdoRS, Grid1, 1
     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 reader where ReaderID='" & txtID.Text & "'"
            Call ExecuteSQL(Sqls, MsgStr)
        End If
        '刷新显示
         MyAdoRS.Close
         Set MyAdoRS = ExecuteSQL(SQL & tj, MsgStr)
          '显示所有记录
         DisplayKeySetGrid MyAdoRS, Grid1, 1
    End If
        
    
End Sub

Private Sub CmdOK_Click()
    Dim s As String
    Dim ss As String
  

    '构造查询条件
    '读者ID
    If ChkID.Value Then
        If txtIDQ.Text = "" Then
            MsgBox "请输入读者ID！"
            Exit Sub
        End If
        s = " ReaderID='" & txtIDQ.Text & "'"
    End If
    '读者状态
    If ChkStatus.Value Then
        If CombStatusQ.Text = "" Then
            MsgBox "请选择读者状态！"
            Exit Sub
        End If
        If s = "" Then
            s = " status='" & CombStatusQ.Text & "'"
        Else
            s = s & " and status='" & CombStatusQ.Text & "'"
        End If
    End If
    
    '读者类别
    If ChkSort.Value Then
        If CombSortQ.Text <> "" Then
            i = InStr(1, CombSortQ.Text, "|")
            ss = Left(CombSortQ.Text, i - 1)
        Else
            MsgBox "请选择读者类别！"
            Exit Sub
        End If
        If s = "" Then
            s = " a.SortCode='" & ss & "'"
        Else
            s = s & " and a.SortCode='" & ss & "'"
        End If
    End If
    '部门
    If ChkDept.Value Then
        If txtDeptQ.Text = "" Then
            MsgBox "请输入部门名称！"
            Exit Sub
        End If
        If s = "" Then
            s = " Department='" & txtDeptQ.Text & "'"
        Else
            s = s & " and Department='" & txtDeptQ.Text & "'"
        End If
    End If
    '增加日期
    If ChkAddDate.Value Then
        If IsDate(txtAdddateQ.Text) Then
            txtAdddateQ.Text = Format(txtAdddateQ.Text, "YYYY-MM-DD")
            If s = "" Then
                s = " adddate='" & txtAdddateQ.Text & "'"
            Else
                s = s & " and adddate='" & txtAdddateQ.Text & "'"
            End If
        Else
            MsgBox "请正确输入添加日期（YYYY-MM-DD）！"
            Exit Sub
        End If
    End If
    If s = "" Then
        MsgBox "请选择查询条件！"
        Exit Sub
    End If
    tj = s & " order by ReaderID"
    '刷新显示
     MyAdoRS.Close
     Set MyAdoRS = ExecuteSQL(SQL & tj, MsgStr)
      '显示所有记录
     DisplayKeySetGrid MyAdoRS, Grid1, 1
End Sub

Private Sub cmdSave_Click()
    Dim rs As ADODB.Recordset
    Dim Sqls As String
    If Trim(CombStatus.Text) = "" Then
        MsgBox "读者状态必须选择！"
        CombStatus.SetFocus
        Exit Sub
    End If
    If mAddNew = True Then
        '查询读者ID重是否复
        Sqls = "select ReaderID from reader where ReaderID='" & txtID.Text & "'"
        Set rs = ExecuteSQL(Sqls, MsgStr)
        If Not rs.EOF Then
            MsgBox ("读者ID重复,请重新输入!")
            Exit Sub
        Else
            '默认口令为读者ID
            If txtPass.Text = "" Then txtPass.Text = txtID.Text
            '获得用户类别编码
            i = InStr(1, CombSort.Text, "|")
            s = Left(CombSort.Text, i - 1)
            Sqls = "insert into reader(ReaderID,SortCode,Name,Sex,Department,Password,Adddate,FreeNum,status)"
            Sqls = Sqls & " values('" & txtID.Text & "','" & s & "','" & txtName.Text & "','"
            Sqls = Sqls & CombSex.Text & "','" & txtDept.Text & "','" & txtPass.Text & "','" & txtAdd.Text & "',"
            Sqls = Sqls & MaxDay(CombSort.ListIndex) & ",'" & CombStatus.Text & "')"
            ExecuteSQL Sqls, MsgStr
        End If
    Else
        If txtPass.Text = "" Then txtPass.Text = txtID.Text
        '获得用户类别编码
        i = InStr(1, CombSort.Text, "|")
        s = Left(CombSort.Text, i - 1)
        Sqls = "update  reader set SortCode='" & s & "',Name='" & txtName.Text & "',"
        Sqls = Sqls & "Sex='" & CombSex.Text & "',Department='" & txtDept.Text & "',Password='" & txtPass.Text & "',"
        Sqls = Sqls & "Adddate='" & txtAdd.Text & "',status='" & CombStatus.Text & "'"
        Sqls = Sqls & " where ReaderID='" & txtID.Text & "'"
        ExecuteSQL Sqls, MsgStr
    End If
    '刷新显示
    MyAdoRS.Close
    Set MyAdoRS = ExecuteSQL(SQL & tj, MsgStr)
     '显示所有记录
    DisplayKeySetGrid MyAdoRS, Grid1, 1
     Call TxtEdit(True)
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语句指定的数据集
    tj = " Adddate='" & Format(Now, "YYYY-MM-DD") & "' order by ReaderID"
    SQL = "select ReaderID 读者号,SortName 读者类别 ,Name 姓名,Sex 性别,Department  部门,"
    SQL = SQL & "CONVERT(char(10),Adddate,120) 加入日期,Status 状态 from reader A inner "
    SQL = SQL & " join readersort B on a.sortcode=b.sortcode where "
    
    Set MyAdoRS = ExecuteSQL(SQL & tj, MsgStr)
     '显示所有记录
    DisplayKeySetGrid MyAdoRS, Grid1, 1
    
    '
    '为读者类别列表框CombSort添加数据
    Sqls = "select SortCode,SortName,MaxNum from readersort "
    Set rs = ExecuteSQL(Sqls, MsgStr)
    If Not rs.EOF Then
        ReDim MaxDay(rs.RecordCount)  '记录各类读者可借阅数量
    End If
    Dim i As Integer
    i = 0
    Do Until rs.EOF
        CombSort.AddItem rs!SortCode & "|" & rs!sortname
        CombSortQ.AddItem rs!SortCode & "|" & rs!sortname
        MaxDay(i) = rs!MaxNum
        i = i + 1
        rs.MoveNext
    Loop
    rs.Close
    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
    For i = 0 To CombSort.ListCount - 1
        If InStr(1, CombSort.List(i), Grid1.Text) > 0 Then
            CombSort.Text = CombSort.List(i)
        End If
    Next i
    Grid1.Col = 3
    txtName.Text = Grid1.Text
    Grid1.Col = 4
    CombSex.Text = Grid1.Text
    Grid1.Col = 5
    txtDept.Text = Grid1.Text
    Grid1.Col = 6
    txtAdd.Text = Grid1.Text
    Grid1.Col = 7
    CombStatus.Text = Grid1.Text
End Sub

Sub TxtClear()
    txtID.Text = ""
    CombSort.Text = ""
    txtName.Text = ""
    CombSex.Text = ""
    txtDept.Text = ""
    txtAdd.Text = ""
    CombStatus.Text = ""
    txtPass = ""
End Sub

Sub TxtEdit(flag As Boolean)
    txtID.Locked = flag
    CombSort.Locked = flag
    txtName.Locked = flag
    CombSex.Locked = flag
    txtDept.Locked = flag
    txtAdd.Locked = flag
    CombStatus.Locked = flag
    CmdUpdate.Enabled = flag
    cmdDelete.Enabled = flag
    cmdAdd.Enabled = flag
    cmdCancel.Enabled = Not flag
    cmdSave.Enabled = Not flag
    cmdClose.Enabled = flag
    CmdOK.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 + 6, "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