📄 settype.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form SetType
BorderStyle = 3 'Fixed Dialog
Caption = "设置图书类别和借出时间"
ClientHeight = 3435
ClientLeft = 45
ClientTop = 330
ClientWidth = 5220
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3435
ScaleWidth = 5220
ShowInTaskbar = 0 'False
Begin VB.PictureBox Picture2
Height = 3135
Left = 120
ScaleHeight = 3075
ScaleWidth = 2955
TabIndex = 6
Top = 120
Width = 3015
Begin VB.CommandButton cmdSaveCancel
Caption = "取消(&C)"
Height = 375
Index = 1
Left = 1800
TabIndex = 13
Top = 2520
Width = 855
End
Begin VB.CommandButton cmdSaveCancel
Caption = "保存(&S)"
Height = 375
Index = 0
Left = 840
TabIndex = 12
Top = 2520
Width = 855
End
Begin VB.Frame Frame1
Height = 135
Left = 240
TabIndex = 11
Top = 2040
Width = 2535
End
Begin MSComCtl2.UpDown UpD
Height = 375
Left = 1920
TabIndex = 10
Top = 1560
Width = 225
_ExtentX = 450
_ExtentY = 661
_Version = 393216
BuddyControl = "comTime"
BuddyDispid = 196612
OrigLeft = 1920
OrigTop = 1440
OrigRight = 2145
OrigBottom = 1695
Max = 1000
SyncBuddy = -1 'True
BuddyProperty = 0
Enabled = -1 'True
End
Begin VB.ComboBox comTime
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 840
TabIndex = 9
Top = 1560
Width = 1095
End
Begin VB.TextBox txtTypeName
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 840
TabIndex = 0
Top = 720
Width = 1815
End
Begin VB.Label labFlag
AutoSize = -1 'True
Caption = "添加"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 240
Left = 1680
TabIndex = 15
Top = 120
Width = 525
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "规定借出时间"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Index = 1
Left = 120
TabIndex = 8
Top = 1200
Width = 1260
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "类别名称"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Index = 0
Left = 120
TabIndex = 7
Top = 360
Width = 840
End
End
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
Height = 3135
Left = 3360
ScaleHeight = 3135
ScaleWidth = 1575
TabIndex = 2
Top = 120
Width = 1575
Begin VB.CommandButton cmdEdit
Caption = "修改类别"
Height = 735
Left = 0
TabIndex = 14
Top = 720
Width = 1575
End
Begin VB.CommandButton cmdExit
Caption = "关闭返回"
Height = 735
Left = 0
TabIndex = 5
Top = 2400
Width = 1575
End
Begin VB.CommandButton cmdDelete
Caption = "删除类别"
Height = 735
Left = 0
TabIndex = 4
Top = 1680
Width = 1575
End
Begin VB.CommandButton cmdAdd
Caption = "添加类别"
Height = 735
Left = 0
TabIndex = 3
Top = 0
Width = 1575
End
End
Begin MSComctlLib.ListView Lv
Height = 3135
Left = 120
TabIndex = 1
Top = 120
Width = 2895
_ExtentX = 5106
_ExtentY = 5530
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "图书类别"
Object.Width = 2469
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "规定借出时间"
Object.Width = 2540
EndProperty
End
Begin VB.Menu MainMnu
Caption = "MainMnu"
Visible = 0 'False
Begin VB.Menu AddMnu
Caption = "添加类别(&A)"
Shortcut = ^A
End
Begin VB.Menu EditMnu
Caption = "编辑类别(&E)"
Shortcut = ^E
End
Begin VB.Menu s1
Caption = "-"
End
Begin VB.Menu DeleteMnu
Caption = "删除类别(&D)"
Shortcut = ^D
End
Begin VB.Menu ShowMnu
Caption = "显示所有类别(&S)"
Shortcut = ^S
End
Begin VB.Menu s2
Caption = "-"
End
Begin VB.Menu ExitMnu
Caption = "退出(&X)"
Shortcut = ^X
End
End
End
Attribute VB_Name = "SetType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' **********************************************************************
' 描 述：银龙图书管理系统
' 中国VB网收集整理 http://www.ChinaVB.net
' QQ交流群：13047826 14356878
' 发表源码或文章请发邮件到:info@chinavb.net
' **********************************************************************Dim i As Integer
Dim db As Database '用于连接数据库
Dim rst As Recordset '用于打开表Type
Dim Rec As Integer '用于存放记录总数
Dim StrFlag As String '用于字符的变换
Dim Se As Integer '用于选择项目的索引值
Dim TiShi As String '用于提示信息'
Private Sub AddMnu_Click()
'调用cmdAdd_Click过程
cmdAdd_Click
End Sub
Private Sub cmdAdd_Click()
'保存按钮，用于保存添加状态时内容
StrFlag = "添加"
labFlag.Caption = "添加状态"
'设置类别名称和规定借出时间为空
txtTypeName = ""
comTime = ""
'ListView控件隐藏，Picture2图片框出现
Lv.Visible = False
Picture2.Visible = True
'调用cmdFlag过程，使添加、修改、删除按钮不可用
cmdFlag (False)
End Sub
Private Sub cmdDelete_Click()
'删除类别按钮
'对选定项目和数据库比较，给出提示
rst.Seek "=", Lv.SelectedItem.Text
TiShi = "确实要删除[" & Lv.SelectedItem.Text & "]类吗？"
If MsgBox(TiShi, 4 + 32, "删除类别") = vbYes Then
'删除选定记录，调用Disp过程，更新记录显示
rst.Delete
Disp
Else
Exit Sub
End If
End Sub
Private Sub cmdEdit_Click()
'修改类别按钮，用于保存修改状态时的内容
StrFlag = "编辑"
labFlag.Caption = "修改状态"
'将选定项目给变量Se，和数据库比较
Se = Lv.SelectedItem.Index
rst.Seek "=", Lv.SelectedItem.Text
txtTypeName.Text = rst.Fields("类别")
comTime.Text = rst.Fields("借出天数")
'Picture2图片框出现，ListView控件隐藏
Picture2.Visible = True
Lv.Visible = False
'调用cmdFlag过程，使添加、修改、删除按钮不可用
cmdFlag (False)
End Sub
Private Sub cmdExit_Click()
'关闭本窗体
Unload Me
End Sub
Private Sub cmdSaveCancel_Click(Index As Integer)
'下面为保存按钮和取消按钮的控件数组
Select Case Index
Case 0 '保存按钮
'判断操作状态为添加时的过程
If StrFlag = "添加" Then
'判断类别名称为空或规定借出时间为空时，给出提示
If txtTypeName.Text = "" Or comTime.Text = "" Then
MsgBox "请填写完整！", 0 + 48, "提示"
Exit Sub
End If
'输入框不为空时执行添加，如数据库存在该记录，给出提示
rst.Seek "=", Trim(txtTypeName)
If rst.NoMatch = False Then
MsgBox txtTypeName & " 类别已经存在，请填写其它类！", 0 + 48, "类别重复"
txtTypeName.SetFocus
Exit Sub
End If
'将新记录添加到数据库
rst.AddNew
rst.Fields("类别") = Trim(txtTypeName.Text) & vbNullString
rst.Fields("借出天数") = Trim(comTime.Text) & vbNullString
rst.Update
'Picture2图片框隐藏，ListView控件显示
Picture2.Visible = False
Lv.Visible = True
'调用Disp过程，显示记录
Disp
'调用cmdFlag过程，使添加、修改、删除按钮可用
cmdFlag (True)
'判断操作状态为编辑时的过程
ElseIf StrFlag = "编辑" Then
'判断类别名称为空或规定借出时间为空时，给出提示
If txtTypeName.Text = "" Or comTime.Text = "" Then
MsgBox "请填写完整！", 0 + 48, "提示"
Exit Sub
End If
'将修改后内容存入数据库
rst.Edit
rst.Fields("类别") = Trim(txtTypeName.Text)
rst.Fields("借出天数") = Trim(comTime.Text)
rst.Update
'Picture2图片框出现，ListView控件（显示记录）出现
Picture2.Visible = False
Lv.Visible = True
'调用Disp过程，显示更新后的记录
Disp
'使所有按钮可用
cmdFlag (True)
End If
Case 1 '取消按钮
'图片框2隐藏，显示记录出现
Picture2.Visible = False
Lv.Visible = True
cmdFlag (True)
End Select
End Sub
Private Sub DeleteMnu_Click()
'菜单--删除类别
cmdDelete_Click
End Sub
Private Sub EditMnu_Click()
'菜单--编辑类别
cmdEdit_Click
End Sub
Private Sub ExitMnu_Click()
cmdExit_Click
End Sub
Private Sub Form_Load()
'ListView控件（图书类别列表）显示，Picture2图片框隐藏
Lv.Visible = True
Picture2.Visible = False
'设置数据库路径
DBpath = App.Path + "\DataBase\Data.mdb"
'连接数据库，打开表Type
Set db = Workspaces(0).OpenDatabase(DBpath, False)
Set rst = db.OpenRecordset("Type", dbOpenTable)
'对字段类别进行索引
rst.Index = "类别"
'调用Disp过程，显示记录
Disp
End Sub
'定义Disp过程，用于显示更新后的记录
Private Sub Disp()
'清空列表内的记录，
Lv.ListItems.Clear
rst.MoveLast
'将记录总数给变量：Rec
Rec = rst.RecordCount
rst.MoveFirst
'显示所有记录
For i = 1 To Rec
Lv.ListItems.Add i, , rst.Fields("类别")
Lv.ListItems(i).SubItems(1) = rst.Fields("借出天数")
rst.MoveNext
'如果到末尾，退出循环
If rst.EOF Then Exit For
Next
End Sub
'定义cmdFlag过程，用于禁用按钮
Private Sub cmdFlag(Bool As Boolean)
cmdAdd.Enabled = Bool
cmdEdit.Enabled = Bool
cmdDelete.Enabled = Bool
End Sub
Private Sub Form_Unload(Cancel As Integer)
'关闭窗体时，关闭已打开的数据库
rst.Close
db.Close
End Sub
'ListView的双击过程：调用cmdEdit_Click过程编辑记录
Private Sub Lv_DblClick()
cmdEdit_Click
End Sub
'ListView的右击过程，弹出隐藏的菜单MainMnu
Private Sub Lv_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
PopupMenu MainMnu
End If
End Sub
'菜单--显示所有记录
Private Sub ShowMnu_Click()
Disp
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -