menu41.frm

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

         Left            =   120
         TabIndex        =   6
         Top             =   2040
         Width           =   1335
      End
      Begin VB.Label Label4 
         Caption         =   "图书入库"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   840
         Width           =   1335
      End
      Begin VB.Label Label3 
         Caption         =   "基础资料"
         Height          =   375
         Left            =   120
         TabIndex        =   4
         Top             =   1440
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "图书借阅"
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   1335
      End
   End
   Begin VB.ListBox List1 
      Height          =   3300
      Left            =   120
      TabIndex        =   1
      Top             =   1200
      Width           =   2775
   End
   Begin VB.Label Label1 
      Caption         =   "操  作  员  权  限  设  置"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   24
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   975
      Left            =   960
      TabIndex        =   0
      Top             =   120
      Width           =   7215
   End
End
Attribute VB_Name = "winmenu41"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim selectrecord As String
Dim whattodo As String
Dim list1index As Integer
Private Sub truetrue()
For i = 0 To 4
    c1(i).Enabled = True
Next i
ff.Enabled = True
Check17.Enabled = True
Check18.Enabled = True
Check19.Enabled = True
End Sub
Private Sub falsefalse()
For i = 0 To 4
    c1(i).Enabled = False
Next i
ff.Enabled = False
Check17.Enabled = False
Check18.Enabled = False
Check19.Enabled = False
End Sub
Private Sub editcocancel()
coadd.Enabled = False
codel.Enabled = False
comodi.Enabled = False
coquit.Enabled = False
End Sub
Private Sub editcosure()
coadd.Enabled = True
codel.Enabled = True
comodi.Enabled = True
coquit.Enabled = True
End Sub

Private Sub Check1_Click()
Check1.Value = 1

End Sub

Private Sub Check17_Click()
Check17.Value = 1
End Sub

Private Sub Check18_Click()
Check18.Value = 1
End Sub

Private Sub Check19_Click()
Check19.Value = 1
End Sub

Private Sub Command3_Click()
selectrecord = Trim(Left(List1.Text, 14))
Set tab2 = data1.OpenRecordset("select * from mmk where cjydm='" + selectrecord + "'")
t1 = tab2("cjydm")
t2 = tab2("cjyxm")
t3 = tab2("cjymm")
End Sub

Private Sub coadd_Click()
whattodo = "add"
selectrecord = Trim(Left(List1.Text, 14))
editcocancel
cosure.Enabled = True
cocancel.Enabled = True
t1.Locked = False
t2.Locked = False
t3.Locked = False
t1.SetFocus
For i = 0 To 4
    c1(i).Value = 0
Next i
List1.Enabled = False
Check1.Enabled = True
truetrue
End Sub

Private Sub cocancel_Click()
t1.Locked = True
t2.Locked = True
t3.Locked = True
Check1.Enabled = False
t1 = ""
t2 = ""
t3 = ""
editcosure
cosure.Enabled = False
cocancel.Enabled = False
List1.Enabled = True
falsefalse
End Sub

Private Sub codel_Click()
whattodo = "del"
list1index = List1.ListIndex
selectrecord = Trim(Left(List1.Text, 14))
delyn = MsgBox("您确认要删除此记录吗？", vbQuestion + vbYesNo, "称重系统")
If delyn = vbYes Then
   data1.Execute "delete * from mmk where cjydm='" + selectrecord + "'"
   List1.RemoveItem list1index
   If List1.ListCount >= 1 Then List1.ListIndex = 0
End If
End Sub

Private Sub Command1_Click()
s = ""
For i = 0 To 4
    s1 = Trim(Str(c1(i).Value))
    s = s & s1
Next i
End Sub

Private Sub comodi_Click()
whattodo = "modi"
selectrecord = Trim(Left(List1.Text, 14))
Set tab2 = data1.OpenRecordset("select * from mmk where cjydm='" + selectrecord + "'")
If tab2.EOF Then MsgBox "对不起，无选择对象或选择对象已不存在，不能进行修改！", vbExclamation + vbOKOnly, "华欧称重": Exit Sub
t1 = tab2("cjydm")
t2 = tab2("cjyxm")
t3 = tab2("cjymm")
t1.Locked = False
t2.Locked = False
t3.Locked = False
editcocancel
cosure.Enabled = True
cocancel.Enabled = True
list1index = List1.ListIndex
t1.SetFocus
List1.Enabled = False
Check1.Enabled = True
truetrue
End Sub

Private Sub coquit_Click()
Unload Me
End Sub

Private Sub cosure_Click()
s = ""
For i = 0 To 4
    s1 = Trim(Str(c1(i).Value))
    s = s & s1
Next i
t1 = LeftB(t1, 20)
t2 = LeftB(t2, 20)
t3 = LeftB(t3, 30)
If Trim(t1) = "" Then
  MsgBox "操作员代码不能为空!", vbExclamation + vbOKOnly, "称重系统"
  Exit Sub
End If
If Trim(t1) = "888" Then
   MsgBox "此操作员代码为系统内用，请换用其它代码！", vbExclamation + vbOKOnly, "操作警告"
   t1 = ""
   t1.SetFocus
   Exit Sub
End If
If Trim(t2) = "" Then
  MsgBox "操作员姓名不能为空!", vbExclamation + vbOKOnly, "称重系统"
  Exit Sub
End If
If Trim(t2) = "程序主管" Then
   MsgBox "此操作员姓名为系统内用，请换用其它代码！", vbExclamation + vbOKOnly, "操作警告"
   t2.Text = ""
   t2.SetFocus
   Exit Sub
End If
If whattodo = "modi" Then '如果是修改命令
   If t1 <> selectrecord Then
      Set tab2 = data1.OpenRecordset("select * from mmk where cjydm='" + t1.Text + "'")
      If Not tab2.EOF Then
         MsgBox "代码修改后与其它代码重复，请修改!", vbExclamation + vbOKOnly, "称重系统"
         Exit Sub
      Else
         data1.Execute "update mmk set cjydm='" + t1.Text + "',cjyxm='" + t2.Text + "',cjymm='" + t3.Text + "',cjyqx='" + s + " ' where cjydm='" + selectrecord + "'"
      End If
   Else
      data1.Execute "update mmk set cjydm='" + t1.Text + "',cjyxm='" + t2.Text + "',cjymm='" + t3.Text + "',cjyqx='" + s + " ' where cjydm='" + selectrecord + "'"
   End If
   List1.Clear
   Set tab1 = data1.OpenRecordset("select * from  mmk order by val(cjydm) ")
   Do Until tab1.EOF
      List1.AddItem tab1("cjydm") + Space(14 - Len(tab1("cjydm"))) + tab1("cjyxm")
     tab1.MoveNext
   Loop
   If List1.ListCount > 1 Then List1.ListIndex = list1index
Else
   Set tab2 = data1.OpenRecordset("select * from mmk where cjydm='" + t1.Text + "'")
   If Not tab2.EOF Then
      MsgBox "新增操作员代码与其它操作员代码重复，请修改!", vbExclamation + vbOKOnly, "称重系统"
         Exit Sub
   End If
   data1.Execute "insert into  mmk (cjydm,cjyxm,cjymm,cjyqx) values ('" + t1.Text + "','" + t2.Text + "','" + t3.Text + "','" + s + "') "
   List1.AddItem t1 + Space(14 - Len(t1)) + t2
End If
editcosure
cosure.Enabled = False
cocancel.Enabled = False
Check1.Enabled = False
t1.Locked = True
t2.Locked = True
t3.Locked = True
t1 = ""
t2 = ""
t3 = ""
List1.Enabled = True
falsefalse

End Sub

Private Sub ff_Click()
ff.Value = 1
End Sub

Private Sub Form_Load()
Set tab1 = data1.OpenRecordset("select * from  mmk order by val(cjydm) ")
Do Until tab1.EOF
   List1.AddItem tab1("cjydm") + Space(14 - Len(tab1("cjydm"))) + tab1("cjyxm")
  tab1.MoveNext
Loop
If List1.ListCount > 0 Then List1.ListIndex = 0
Me.Left = 500
Me.Top = 400
Me.Width = 10875
Me.Height = 6800 + 300
falsefalse
Check1.Enabled = False
End Sub

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

Private Sub List1_Click()
selectrecord = Trim(Left(List1.Text, 14))
Set tab2 = data1.OpenRecordset("select * from mmk where cjydm='" + selectrecord + "'")
If tab2.EOF Then Exit Sub
s = tab2("cjyqx")
For i = 0 To 4
    c1(i).Value = Val(Mid(s, i + 1, 1))
Next i

End Sub

Private Sub t1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then t2.SetFocus
If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 46 Then KeyAscii = 0
End Sub

Private Sub t2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then t3.SetFocus
End Sub

Private Sub t3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then If cosure.Enabled = True Then cosure.SetFocus
End Sub