frmastu.frm

第一次用VB编写的图书管理系统,仅供大家参考,呵呵,不足之处多多包含

      TabIndex        =   6
      Top             =   600
      Width           =   540
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "出生日期"
      Height          =   180
      Left            =   120
      TabIndex        =   5
      Top             =   1320
      Width           =   720
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "系  别"
      Height          =   180
      Left            =   120
      TabIndex        =   4
      Top             =   960
      Width           =   540
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "班  级"
      Height          =   180
      Left            =   2880
      TabIndex        =   3
      Top             =   960
      Width           =   540
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "性　别"
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "学生姓名"
      Height          =   180
      Left            =   2880
      TabIndex        =   1
      Top             =   240
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "学生学号"
      Height          =   180
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   720
   End
End
Attribute VB_Name = "FrmAstu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim blnfind As Boolean
Private Sub InBox()
txtNum = DBRct.Fields("readerid").Value
txtName = DBRct.Fields("readername").Value
cmbSex.Text = DBRct.Fields("sex").Value
If DBRct.Fields("fro").Value <> Empty Then txtG = DBRct.Fields("fro").Value Else txtG = ""
If DBRct.Fields("gread").Value <> Empty Then txtGre = DBRct.Fields("gread").Value Else txtGre = ""
If DBRct.Fields("class").Value <> Empty Then txtCla = DBRct.Fields("class").Value Else txtCla = ""
If DBRct.Fields("birthday").Value <> Empty Then txtBirth = DBRct.Fields("birthday").Value Else txtBirth = ""
If DBRct.Fields("joindate").Value <> Empty Then txtJoin = DBRct.Fields("joindate").Value Else txtJoin = ""
If DBRct.Fields("address").Value <> Empty Then txtAddress = DBRct.Fields("address").Value Else txtAddress = ""
If DBRct.Fields("publish").Value <> Empty Then txtPublish = DBRct.Fields("publish").Value Else txtPublish = ""
End Sub

Private Sub CmdAdd_Click()
 Call QueryInfo("select * from readers where readerid='" & Choose(txtNum) & "'")
 If Not DBRct.EOF Then MsgBox "该学好号已存在！", vbInformation, "出错": Exit Sub
 Call ExecuteSQL("insert into readers(readerid,readername,sex,fro,gread,class,birthday,joindate,address) values ('" & _
                  Choose(txtNum) & "','" & Choose(txtName) & "','" & Choose(cmbSex.Text) & "','" & Choose(txtG) & "','" & Choose(txtGre) & "','" & Choose(txtCla) & "','" & _
                  Choose(txtBirth) & "','" & Choose(txtJoin) & "','" & Choose(txtAddress) & "')")
 Call QueryInfo("select * from readers where readerid='" & Choose(txtNum) & "'")
 If Not DBRct.EOF Then MsgBox "增加信息成功！", vbInformation, "成功" Else MsgBox "数据不符合要求！", vbInformation, "失败"
End Sub

Private Sub CmdBorr_Click()
 Dim DBrct2 As New ADODB.Recordset
 Call CmdFind_Click
 Do Until flx.Rows = 2
 flx.RemoveItem (flx.Rows - 1)
 Loop
  If Not blnfind Then Exit Sub
   cmdCha(0).Enabled = False
   cmdCha(1).Enabled = False
   cmdCha(2).Enabled = False
   cmdCha(3).Enabled = False
 Call QueryInfo("select books.bookid,bookname,author,price,reborrow,datediff(day,borrowdate,getdate()) as [day]" & _
                "from books join borrow on books.bookid=borrow.bookid where readerid='" & _
                txtNum & "' and returndate is null")
 If DBRct.EOF Then Exit Sub
  DBRct.MoveFirst
  Call borrowInfo
 If Opt2.Value Then
  Call QueryInfo("select books.bookid,bookname,author,price,reborrow,datediff(day,borrowdate,returndate) as [day]" & _
                "from books join borrow on books.bookid=borrow.bookid where readerid='" & _
                txtNum & "' and returndate is not null")
   DBRct.MoveFirst
 If DBRct.EOF Then Exit Sub
  Call borrowInfo
 End If
 txtBcount = flx.Rows - 2
End Sub

Private Sub cmdCha_Click(Index As Integer)
Select Case Index
 Case 0: DBRct.MoveFirst
 Case 1: DBRct.MovePrevious: If DBRct.BOF Then DBRct.MoveLast
 Case 2: DBRct.MoveNext: If DBRct.EOF Then DBRct.MoveFirst
 Case 3: DBRct.MoveLast
End Select
Call InBox
End Sub

Private Sub cmdDel_Click()
Call QueryInfo("select * from readers where readerid='" & Choose(txtNum) & "'")
 If DBRct.EOF Then MsgBox "该学好号不存在！", vbInformation, "出错": Exit Sub
 If MsgBox("确认要删除:" & DBRct.Fields("readername").Value & "吗？", vbInformation + vbYesNo, "删除提示") = vbYes Then
 Call ExecuteSQL("delete readers where readerid='" & Choose(txtNum) & "'")
 DBRct.Delete
 DBRct.MoveNext
 MsgBox "删除学生资料成功！", vbInformation, "成功"
 End If
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub CmdFind_Click()
Dim Sql As String
 Sql = "select * from readers where readerid is not null "
 If txtNum <> Empty Then Sql = Sql & "and readerid like '%" & Choose(txtNum) & "%'"
 If txtName <> Empty Then Sql = Sql & "and readername like '%" & Choose(txtName) & "%'"
 If cmbSex.Text <> Empty Then Sql = Sql & "and sex = '" & Choose(cmbSex.Text) & "'"
 If txtG <> Empty Then Sql = Sql & "and fro like '%" & Choose(txtG) & "%'"
 If txtGre <> Empty Then Sql = Sql & "and gread like '%" & Choose(txtGre) & "%'"
 If txtCla <> Empty Then Sql = Sql & "and class like '%" & Choose(txtCla) & "%'"
 If txtBirth <> Empty Then Sql = Sql & "and birthday = '" & Format(Choose(txtBirth), "yyyy-mm-dd") & "'"
 If txtJoin <> Empty Then Sql = Sql & "and joindate = '" & Format(Choose(txtJoin), "yyyy-mm-dd") & "'"
 If txtAddress <> Empty Then Sql = Sql & "and address like '%" & Choose(txtAddress) & "%'"
 Call QueryInfo(Sql)
 If DBRct.EOF Then
  MsgBox "未查到数据！", vbInformation, "无数据"
   blnfind = False
   cmdCha(0).Enabled = False
   cmdCha(1).Enabled = False
   cmdCha(2).Enabled = False
   cmdCha(3).Enabled = False
 Else: DBRct.MoveFirst: Call InBox
  blnfind = True
  cmdCha(0).Enabled = True
  cmdCha(1).Enabled = True
  cmdCha(2).Enabled = True
  cmdCha(3).Enabled = True
 End If
End Sub

Private Sub CmdModify_Click()
Call QueryInfo("select * from readers where readerid='" & Choose(txtNum) & "'")
 If DBRct.EOF Then MsgBox "该学好号不存在！", vbInformation, "出错": Exit Sub
Dim Sql As String
 Sql = "update readers set readerid='" & Choose(txtNum) & "'"
 If txtName <> Empty Then Sql = Sql & ",readername='" & Choose(txtName) & "'"
 If cmbSex.Text <> Empty Then Sql = Sql & ",sex = '" & Choose(cmbSex.Text) & "'"
 If txtG <> Empty Then Sql = Sql & ",fro='" & Choose(txtG) & "'"
 If txtGre <> Empty Then Sql = Sql & ",gread='" & Choose(txtGre) & "'"
 If txtCla <> Empty Then Sql = Sql & ",class='" & Choose(txtCla) & "'"
 If txtBirth <> Empty Then Sql = Sql & ",birthday= '" & Choose(txtBirth) & "'"
 If txtJoin <> Empty Then Sql = Sql & ",joindate= '" & Choose(txtJoin) & "'"
 If txtAddress <> Empty Then Sql = Sql & ",address='" & Choose(txtAddress) & "'"
 Sql = Sql & " where readerid='" & Choose(txtNum) & "'"
 Call ExecuteSQL(Sql)
 MsgBox "修改学生资料成功！", vbInformation, "成功"
End Sub

Private Sub cmdpay_Click()
On Error GoTo Err:
If txtPublish = 0 Then Exit Sub
 If MsgBox("请确认交了 " & Format(txtPublish, "##0.00") & "元", vbInformation + vbYesNo, "提示") <> 6 Then Exit Sub
DBRct.Fields("publish") = Null
DBRct.Update
Err:
End Sub

Private Sub cmdRef_Click()
txtNum = Empty: txtName = Empty: cmbSex.Text = Empty: txtG = Empty
txtGre = Empty: txtCla = Empty: txtBirth = Empty: txtJoin = Empty
txtAddress = Empty: cmdCha(0).Enabled = False
cmdCha(1).Enabled = False: cmdCha(2).Enabled = False: cmdCha(3).Enabled = False
End Sub

Private Sub Form_Load()
Call loadFlx
End Sub

Private Sub Form_Resize()
If Me.Height <= 500 Or Me.Width <= 1500 Then Exit Sub
Me.Height = 5400
Me.Width = 8700
End Sub

Private Sub borrowInfo()
On Error Resume Next
Dim intIndex As Integer
 intIndex = 1
 Do Until (DBRct.EOF)
    flx.AddItem Empty
    flx.Row = flx.Rows - 1
    flx.Col = 0
    flx.Text = flx.Rows - 2
    flx.CellAlignment = 4
    flx.Col = 1
    flx.Text = DBRct.Fields("bookid").Value
    flx.CellAlignment = 4
    flx.Col = 2
    flx.Text = DBRct.Fields("bookname").Value
    flx.CellAlignment = 4
    flx.Col = 3
    flx.Text = DBRct.Fields("author").Value
    flx.CellAlignment = 4
    flx.Col = 4
    flx.Text = "￥ " & Format(DBRct.Fields("Price").Value, "##0.00")
    flx.CellAlignment = 4
    flx.Col = 5
    flx.Text = DBRct.Fields("day").Value & "天"
    flx.CellAlignment = 4
    flx.Col = 6
    flx.Text = Choose(DBRct.Fields("reborrow").Value)
    flx.CellAlignment = 4
   DBRct.MoveNext
   intIndex = intIndex + 1
 Loop
End Sub
Private Sub loadFlx()
 Dim intIndex As Long
 flx.MergeCells = flexMergeFree
 flx.Row = 0
 flx.ColWidth(0) = 600
 For intIndex = 1 To flx.Cols - 1
  flx.Col = intIndex
  flx.Text = "已 经 借 的 书"
    flx.CellAlignment = 4
  flx.ColWidth(intIndex) = 1350
  flx.CellBackColor = &HC0FFFF
 Next
 flx.MergeRow(0) = True
 flx.Row = 1
 flx.Col = 0
 flx.Text = "序 号"
 flx.CellAlignment = 4
 flx.CellBackColor = RGB(255, 255, 255)
 flx.Col = 1
 flx.Text = "图书编码"
 flx.CellAlignment = 4
 flx.CellBackColor = RGB(255, 255, 255)
 flx.Col = 2
 flx.Text = "图书名字"
 flx.CellAlignment = 4
 flx.CellBackColor = RGB(255, 255, 255)
 flx.Col = 3
 flx.Text = "图书作者"
 flx.CellAlignment = 4
 flx.CellBackColor = RGB(255, 255, 255)
 flx.Col = 4
 flx.Text = "图书价格"
 flx.CellAlignment = 4
 flx.CellBackColor = RGB(255, 255, 255)
 flx.Col = 5
 flx.Text = "借的天数"
 flx.CellAlignment = 4
 flx.CellBackColor = RGB(255, 255, 255)
 flx.Col = 6
 flx.Text = "是否已经续借"
 flx.CellAlignment = 4
 flx.CellBackColor = RGB(255, 255, 255)
End Sub