menu3.frm

大学毕业的课题,可能比较简单一点,入门的人可以

         tedw.SelStart = 0
         tedw.SelLength = 20
         Exit Sub
       End If
       data1.Execute "insert into dw (dw) values ('" + tedw.Text + "')"
       dwlist.AddItem tedw.Text
    Case 1
       telb.Text = LeftB(Trim(telb.Text), 20)
       If telb.Text = "" Then
          MsgBox "所属科类名称不能为空", vbOKOnly + vbExclamation, "图书管理系统"
          telb.SetFocus
          telb.SelStart = 0
          telb.SelLength = 20
          Exit Sub
      End If
      Set tab2 = data1.OpenRecordset("select * from lb where lb='" + telb.Text + "'")
      If tab2.EOF() = False Then
         MsgBox "此所属科类名称已经存在，必须重新输入", vbOKOnly + vbExclamation, "管理系统"
         telb.SetFocus
         telb.SelStart = 0
         telb.SelLength = 20
         Exit Sub
       End If
       data1.Execute "insert into lb (lb) values ('" + telb.Text + "')"
       lblist.AddItem telb.Text
    Case 2
       tebz.Text = LeftB(Trim(tebz.Text), 20)
       If tebz.Text = "" Then
          MsgBox "书籍封装名称不能为空", vbOKOnly + vbExclamation, "图书管理系统"
          tebz.SetFocus
          tebz.SelStart = 0
          tebz.SelLength = 20
          Exit Sub
      End If
      Set tab2 = data1.OpenRecordset("select * from bz where bz='" + tebz.Text + "'")
      If tab2.EOF() = False Then
         MsgBox "此书籍封装名称已经存在，必须重新输入", vbOKOnly + vbExclamation, "管理系统"
         tebz.SetFocus
         tebz.SelStart = 0
         tebz.SelLength = 20
         Exit Sub
       End If
       data1.Execute "insert into bz (bz) values ('" + tebz.Text + "')"
       bzlist.AddItem tebz.Text
     Case 3
       tecbs.Text = LeftB(Trim(tecbs.Text), 20)
       If tecbs.Text = "" Then
          MsgBox "出版社名称不能为空", vbOKOnly + vbExclamation, "图书管理系统"
          tecbs.SetFocus
          tecbs.SelStart = 0
          tecbs.SelLength = 20
          Exit Sub
      End If
      Set tab2 = data1.OpenRecordset("select * from cbs where cbs='" + tecbs.Text + "'")
      If tab2.EOF() = False Then
         MsgBox "此出版社名称已经存在，必须重新输入", vbOKOnly + vbExclamation, "管理系统"
         tecbs.SetFocus
         tecbs.SelStart = 0
         tecbs.SelLength = 20
         Exit Sub
       End If
       data1.Execute "insert into cbs (cbs) values ('" + tecbs.Text + "')"
       cbslist.AddItem tecbs.Text
     Case 4
       tezjlb.Text = LeftB(Trim(tezjlb.Text), 20)
       If tezjlb.Text = "" Then
          MsgBox "证件类别名称不能为空", vbOKOnly + vbExclamation, "图书管理系统"
          tezjlb.SetFocus
          tezjlb.SelStart = 0
          tezjlb.SelLength = 20
          Exit Sub
      End If
      Set tab2 = data1.OpenRecordset("select * from zjlb where zjlb='" + tezjlb.Text + "'")
      If tab2.EOF() = False Then
         MsgBox "此证件类别名称已经存在，必须重新输入", vbOKOnly + vbExclamation, "管理系统"
         tezjlb.SetFocus
         tezjlb.SelStart = 0
         tezjlb.SelLength = 20
         Exit Sub
       End If
       data1.Execute "insert into zjlb (zjlb) values ('" + tezjlb.Text + "')"
       zjlblist.AddItem tezjlb.Text
End Select
End Sub

Private Sub coclose_Click()
Unload Me
End Sub

Private Sub codel_Click()
Select Case whattodo
   Case 0
      If dwlist.SelCount = 0 Then
         MsgBox "无选择计量单位，不能删除，请退出！", vbExclamation + vbOKOnly, "图书管理系统"
         Exit Sub
      End If
      listindex1 = dwlist.ListIndex
      del = MsgBox("确认删除这类计量单位吗？", vbYesNo + vbQuestion, "图书管理系统")
      If del = vbYes Then
         data1.Execute "delete * from dw where dw='" + dwlist.Text + "'"
         dwlist.ListIndex = listindex1
         dwlist.RemoveItem listindex1
         If dwlist.ListCount > 0 Then
            dwlist.ListIndex = 0
         Else
            MsgBox "您的计量单位库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
            tedw.SetFocus
         End If
      End If
   Case 1
      If lblist.SelCount = 0 Then
         MsgBox "无选择所属类别，不能删除，请退出！", vbExclamation + vbOKOnly, "图书管理系统"
         Exit Sub
      End If
      listindex1 = lblist.ListIndex
      del = MsgBox("确认删除这类所属类别吗？", vbYesNo + vbQuestion, "图书管理系统")
      If del = vbYes Then
         data1.Execute "delete * from lb where lb='" + lblist.Text + "'"
         lblist.ListIndex = listindex1
         lblist.RemoveItem listindex1
         If lblist.ListCount > 0 Then
            lblist.ListIndex = 0
         Else
            MsgBox "您的所属类别库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
            telb.SetFocus
         End If
      End If
   Case 2
      If bzlist.SelCount = 0 Then
         MsgBox "无选择收复封装，不能删除，请退出！", vbExclamation + vbOKOnly, "图书管理系统"
         Exit Sub
      End If
      listindex1 = bzlist.ListIndex
      del = MsgBox("确认删除这类收复封装吗？", vbYesNo + vbQuestion, "图书管理系统")
      If del = vbYes Then
         data1.Execute "delete * from bz where bz='" + bzlist.Text + "'"
         bzlist.ListIndex = listindex1
         bzlist.RemoveItem listindex1
         If bzlist.ListCount > 0 Then
            bzlist.ListIndex = 0
         Else
            MsgBox "您的收复封装库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
            tebz.SetFocus
         End If
      End If
    Case 3
      If cbslist.SelCount = 0 Then
         MsgBox "无选择出版社，不能删除，请退出！", vbExclamation + vbOKOnly, "图书管理系统"
         Exit Sub
      End If
      listindex1 = cbslist.ListIndex
      del = MsgBox("确认删除这类出版社吗？", vbYesNo + vbQuestion, "图书管理系统")
      If del = vbYes Then
         data1.Execute "delete * from cbs where cbs='" + cbslist.Text + "'"
         cbslist.ListIndex = listindex1
         cbslist.RemoveItem listindex1
         If cbslist.ListCount > 0 Then
            cbslist.ListIndex = 0
         Else
            MsgBox "您的出版社库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
            tecbs.SetFocus
         End If
      End If
    Case 4
      If zjlblist.SelCount = 0 Then
         MsgBox "无选择证件类别，不能删除，请退出！", vbExclamation + vbOKOnly, "图书管理系统"
         Exit Sub
      End If
      listindex1 = zjlblist.ListIndex
      del = MsgBox("确认删除这类证件类别吗？", vbYesNo + vbQuestion, "图书管理系统")
      If del = vbYes Then
         data1.Execute "delete * from zjlb where zjlb='" + zjlblist.Text + "'"
         zjlblist.ListIndex = listindex1
         zjlblist.RemoveItem listindex1
         If zjlblist.ListCount > 0 Then
            zjlblist.ListIndex = 0
         Else
            MsgBox "您的证件类别库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
            tezjlb.SetFocus
         End If
      End If
End Select
End Sub
 
Private Sub Command1_Click()
Set lstab = data1.OpenRecordset("yb")
Text1 = lstab("bt")
Text2 = lstab("com")

End Sub

Private Sub Command2_Click()
If Text2 = "" Or Text1 = "" Then
   MsgBox "两个值都不能为空!", vbExclamation + vbOKOnly, "称重"
   Exit Sub
End If
data1.Execute "update yb set bt='" + Text1 + "',com='" + Text2 + "'"
End Sub

Private Sub Command3_Click()
teprice = Val(teprice)
If Val(teprice) <= 0 Then
   MsgBox "对不起,单价必须大于零!"
   Exit Sub
End If

data1.Execute "update dfhlk set zpdj='" + teprice + "'"
End Sub

Private Sub Form_Load()
Me.Left = 500
Me.Top = 500
whattodo = 0
Me.Width = 9795
Me.Height = 5550
      Set tab2 = data1.OpenRecordset("select * from dw where len(dw)<>0")
      If tab2.EOF() Then
         MsgBox "您的计量单位库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
         tedw.SetFocus
      Else
         dwlist.Clear
         Do Until tab2.EOF()
            dwlist.AddItem tab2("dw")
            tab2.MoveNext
         Loop
         If dwlist.ListCount > 0 Then dwlist.ListIndex = 0
      End If

SSTab1.Tab = 0

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
mainboot.menunum = "nothing"
mainboot.Picture1.Visible = True

End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
whattodo = SSTab1.Tab
Select Case whattodo
   Case 0
      Set tab2 = data1.OpenRecordset("select * from dw where len(dw)<>0")
      If tab2.EOF() Then
         MsgBox "您的计量单位库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
         tedw.SetFocus
      Else
         dwlist.Clear
         Do Until tab2.EOF()
            dwlist.AddItem tab2("dw")
            tab2.MoveNext
         Loop
         If dwlist.ListCount > 0 Then dwlist.ListIndex = 0
      End If
   Case 1
      Set tab2 = data1.OpenRecordset("select * from lb where len(lb)<>0")
      If tab2.EOF() Then
         MsgBox "您的所属科类库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
         telb.SetFocus
      Else
         lblist.Clear
         Do Until tab2.EOF()
            lblist.AddItem tab2("lb")
            tab2.MoveNext
         Loop
         If lblist.ListCount > 0 Then lblist.ListIndex = 0
      End If
   Case 2
      Set tab2 = data1.OpenRecordset("select * from bz where len(bz)<>0")
      If tab2.EOF() Then
         MsgBox "您的封装类别库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
         tebz.SetFocus
      Else
         bzlist.Clear
         Do Until tab2.EOF()
            bzlist.AddItem tab2("bz")
            tab2.MoveNext
         Loop
         If bzlist.ListCount > 0 Then bzlist.ListIndex = 0
      End If
   Case 3
      Set tab2 = data1.OpenRecordset("select * from cbs where len(cbs)<>0")
      If tab2.EOF() Then
         MsgBox "您的出版社库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
         tecbs.SetFocus
      Else
         cbslist.Clear
         Do Until tab2.EOF()
            cbslist.AddItem tab2("cbs")
            tab2.MoveNext
         Loop
         If cbslist.ListCount > 0 Then cbslist.ListIndex = 0
      End If
   Case 4
      Set tab2 = data1.OpenRecordset("select * from zjlb where len(zjlb)<>0")
      If tab2.EOF() Then
         MsgBox "您的证件类别库为空，请及时增加！", vbOKOnly + vbExclamation, "图书管理系统"
         tezjlb.SetFocus
      Else
         zjlblist.Clear
         Do Until tab2.EOF()
            zjlblist.AddItem tab2("zjlb")
            tab2.MoveNext
         Loop
         If zjlblist.ListCount > 0 Then zjlblist.ListIndex = 0
      End If
End Select
End Sub

Private Sub tecpdj_Change()
If KeyAscii = 13 Then coappe.SetFocus
If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then If KeyAscii <> 46 Then KeyAscii = 0
End Sub

Private Sub tedfhl_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tezpdj.SetFocus
End Sub

Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text2.SetFocus Else KeyAscii = 0
End Sub

Private Sub tezpdj_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tecpdj.SetFocus
If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then If KeyAscii <> 46 Then KeyAscii = 0

End Sub

Private Sub Timer1_Timer()
Text = MSComm1.Input
Text = Left(Text, 8)
If Mid(Text, 1, 1) <> "=" Then Exit Sub
Text = Mid$(Text, 2, 6)
'Text1.Text = Text
For i = 1 To 6
    If Mid(Text, i, 1) <> "0" Then
       If Mid(Text, i, 1) <> "1" Then
          If Mid(Text, i, 1) <> "2" Then
             If Mid(Text, i, 1) <> "3" Then
                If Mid(Text, i, 1) <> "4" Then
                   If Mid(Text, i, 1) <> "5" Then
                      If Mid(Text, i, 1) <> "6" Then
                         If Mid(Text, i, 1) <> "7" Then
                            If Mid(Text, i, 1) <> "8" Then
                               If Mid(Text, i, 1) <> "9" Then
                                  If Mid(Text, i, 1) <> "." Then
                                     Exit Sub
                                  Else
                                     GoTo de:
                                  End If
                               Else
                                  GoTo de:
                               End If '9
                            Else
                               GoTo de:
                            End If '8
                         Else
                            GoTo de:
                         End If '7
                      Else
                         GoTo de:
                      End If '6
                   Else
                      GoTo de:
                   End If '5
                Else
                   GoTo de:
                End If '4
             Else
                GoTo de:
             End If
          Else
             GoTo de:
          End If
       Else
          GoTo de:
       End If
    Else
       GoTo de:
    End If
de:
Next i
wb = Text
wenben = Mid$(wb, 6, 1) + Mid$(wb, 5, 1) + Mid$(wb, 4, 1) + Mid$(wb, 3, 1) + Mid$(wb, 2, 1) + Mid$(wb, 1, 1)  '2001-3-20
If Val(wenben) = Val(Text6.Text) Then Exit Sub
If Val(wenben) = 0 Then If Val(Text6.Text) = 0 Then Exit Sub
Text6.Text = Val(wenben)
End Sub