📄 menu12.frm
字号:
Caption = "单位"
Height = 255
Left = 6120
TabIndex = 18
Top = 2115
Width = 615
End
Begin VB.Label Label43
BackStyle = 0 'Transparent
Caption = "条码"
Height = 255
Left = 3480
TabIndex = 17
Top = 2115
Width = 1575
End
Begin VB.Label Label44
BackStyle = 0 'Transparent
Caption = "作者"
Height = 255
Left = 3480
TabIndex = 16
Top = 1800
Width = 735
End
Begin VB.Label xttime
BackStyle = 0 'Transparent
Caption = "系统日期"
Height = 255
Left = 240
TabIndex = 15
Top = 1080
Width = 2895
End
Begin VB.Label Label40
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "科类"
Height = 180
Left = 9000
TabIndex = 14
Top = 2115
Width = 360
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "流水号："
Height = 255
Left = 8880
TabIndex = 13
Top = 1080
Width = 735
End
Begin VB.Label lalsh
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 9720
TabIndex = 12
Top = 1080
Width = 1800
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "出版社"
Height = 255
Left = 6000
TabIndex = 11
Top = 1740
Width = 975
End
End
End
Attribute VB_Name = "winmenu12"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim whattodo As String '判定执行的是毛重还是皮重
Private Sub bgclear()
Do While bg.Rows - 1 > 1
bg.RemoveItem (1)
Loop
bg.Row = 1
bg.Col = 0: bg.Text = ""
bg.Col = 1: bg.Text = ""
bg.Col = 2: bg.Text = ""
bg.Col = 3: bg.Text = ""
bg.Col = 4: bg.Text = ""
bg.Col = 5: bg.Text = ""
bg.Col = 6: bg.Text = ""
bg.Col = 7: bg.Text = ""
End Sub
Private Sub intobg()
On Error Resume Next
Do Until tab3.EOF
b0 = tab3("bh")
b1 = tab3("name")
b2 = tab3("man")
b3 = tab3("cbs")
b4 = tab3("cbrq")
b5 = tab3("lb")
b6 = tab3("price")
b7 = tab3("sl")
bg.Row = 1
bg.Col = 0
If bg.Text = "" Then
bg.Row = 1
bg.Col = 0: bg.Text = b0
bg.Col = 1: bg.Text = b1
bg.Col = 2: bg.Text = b2
bg.Col = 3: bg.Text = b3
bg.Col = 4: bg.Text = b4
bg.Col = 5: bg.Text = b5
bg.Col = 6: bg.Text = b6
bg.Col = 7: bg.Text = b7
Else
bg.AddItem (b0 & vbTab & b1 & vbTab & b2 & vbTab & b3 & vbTab & b4 & vbTab & b5 & vbTab & b6 & vbTab & b7)
End If
tab3.MoveNext
Loop
End Sub
Private Sub lrok()
tename.Locked = False
teman.Locked = False
cocbs.Locked = False
teprice.Locked = False
tenumber.Locked = False
codw.Locked = False
colb.Locked = False
cobz.Locked = False
tesay.Locked = False
teremark.Locked = False
tecbrq.Locked = False
tesl.Locked = False
End Sub
Private Sub lrcancel()
'设定可录入的TEXT框为不可用
tename.Locked = True
tename = ""
teman.Locked = True
teman = ""
cocbs.Locked = True
cocbs = ""
teprice.Locked = True
teprice = ""
tenumber.Locked = True
tenumber = ""
codw.Locked = True
codw = ""
colb.Locked = True
colb = ""
cobz.Locked = True
cobz = ""
tesay.Locked = True
tesay = ""
teremark.Locked = True
teremark = ""
tecbrq.Locked = True
tecbrq = ""
lalsh = ""
tesl.Locked = True
tesl = ""
End Sub
Private Sub coadd_Click()
whattodo = "add"
lrok
coadd.Enabled = False
comodi.Enabled = False
cocancel.Enabled = True
cosave.Enabled = True
Set tab1 = data2.OpenRecordset("select * from ruku order by val(bh) ")
If tab1.EOF Then
lalsh.Caption = "1"
Else
tab1.MoveLast
lalsh.Caption = Val(tab1("bh")) + 1
End If
tename.SetFocus
End Sub
Private Sub cocancel_Click()
coadd.Enabled = True
comodi.Enabled = True
cocancel.Enabled = False
cosave.Enabled = False
lrcancel
End Sub
Private Sub comodi_Click()
Set tab1 = data2.OpenRecordset("select * from ruku order by val(bh)")
If tab1.EOF Then MsgBox "库中无数据，请首先作录入!": Exit Sub
sta:
s1 = mainboot.Left + 2200
s2 = mainboot.Top + 3800
ss = InputBox("请输入要进行修改的流水编号：", "修改", , s1, s2)
If ss = "" Then Exit Sub
Set tab1 = data2.OpenRecordset("select * from ruku where bh='" + ss + "'")
If tab1.EOF Then
YesNo = MsgBox("无此流水编号，是否继续进行录入？", vbYesNo + vbQuestion, "图书管理系统")
If YesNo = vbYes Then
GoTo sta:
Exit Sub
Else
Exit Sub
End If
Else
lalsh = ss
tename = tab1("name")
teman = tab1("man")
cocbs = tab1("cbs")
teprice = tab1("price")
tenumber = tab1("num")
codw = tab1("dw")
colb = tab1("lb")
cobz = tab1("bz")
tesay = tab1("say")
teremark = tab1("remark")
tesay = tab1("say")
tecbrq = tab1("cbrq")
lrok
End If
whattodo = "modi"
coadd.Enabled = False
comodi.Enabled = False
cocancel.Enabled = True
cosave.Enabled = True
End Sub
Private Sub coquit_Click()
Unload Me
End Sub
Private Sub cosave_Click()
If Trim(tename) = "" Then
MsgBox "对不起,书名不能为空!", vbExclamation + vbOKOnly, "图书管理系统"
tename.SetFocus
Exit Sub
End If
If teman = "" Then teman = " "
If cocbs = "" Then cocbs = " "
If teprice = "" Then teprie = " "
If tenumber = "" Then tenumber = " "
If codw = "" Then codw = " "
If colb = "" Then colb = " "
If cobz = "" Then cobz = " "
If tesay = "" Then tesay = ""
If teremark = "" Then teremark = " "
If tecbrq = "" Then tecbrq = " "
If whattodo = "add" Then
data2.Execute "insert into ruku (name,man,cbs,price,num,dw,lb,bz,say,remark,bh,rq,time1,czy,cbrq,sl) values ('" + tename + "','" + teman + "','" + cocbs + "','" + teprice + "','" + tenumber + "','" + codw + "','" + colb + "','" + cobz + "','" + tesay + "','" + teremark + "','" + lalsh + " ','" + Date$ + "','" + Time$ + "','" + teczy + "','" + tecbrq + "','" + tesl + "')"
Set tab3 = data2.OpenRecordset("select * from ruku where bh='" + lalsh.Caption + "'")
intobg
Else
data2.Execute "update ruku set name='" + tename + "',man='" + teman + "',cbs='" + cocbs + "',price='" + teprice + "',num ='" + tenumber + "',dw='" + codw + "',lb='" + colb + "',bz='" + cobz + "',say='" + tesay + "',remark='" + teremark + "',bh='" + lalsh + "',rq='" + Date$ + "',time1='" + Time$ + "',czy='" + teczy + "',cbrq='" + tecbrq + "' where bh='" + lalsh + "' "
End If
lrcancel
coadd.Enabled = True
comodi.Enabled = True
cocancel.Enabled = False
cosave.Enabled = False
End Sub
Private Sub Form_Load()
Set myname = data1.OpenRecordset("table1")
Me.Caption = myname("mainame") + "图书管理系统"
Frame1.Visible = True
Me.Left = 0
Me.Top = 0
Me.Width = 12120 - 190 '9540
Me.Height = 8700 - 750 '6144
Frame1.Left = 0
Frame1.Top = 0
Frame1.Width = 12120 - 190
Frame1.Height = 8700 - 450
xttime.Caption = Str$(Year(DateValue(Date$))) + "年" + Str$(Month(DateValue(Date$))) + "月" + Str$(Day(DateValue(Date$))) + "日" + Str$(Hour(Time())) + "时" + Str$(Minute(Time())) + "分" + Str$(Second(Time())) + "秒"
Set tab3 = data2.OpenRecordset("select * from ruku order by val(bh)")
If Not tab3.EOF Then intobg
Set tab2 = data1.OpenRecordset("QXK")
teczy.Text = tab2.Fields("cjyxm")
cocbs.Clear '车型
Set tab1 = data1.OpenRecordset("cbs")
Do Until tab1.EOF
cocbs.AddItem tab1("cbs")
tab1.MoveNext
Loop
codw.Clear '车型
Set tab1 = data1.OpenRecordset("dw")
Do Until tab1.EOF
codw.AddItem tab1("dw")
tab1.MoveNext
Loop
colb.Clear '车型
Set tab1 = data1.OpenRecordset("lb")
Do Until tab1.EOF
colb.AddItem tab1("lb")
tab1.MoveNext
Loop
cobz.Clear '车型
Set tab1 = data1.OpenRecordset("bz")
Do Until tab1.EOF
cobz.AddItem tab1("bz")
tab1.MoveNext
Loop
coadd.Enabled = True
comodi.Enabled = True
cocancel.Enabled = False
cosave.Enabled = False
lrcancel
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
mainboot.Picture1.Visible = True
End Sub
Private Sub Timer1_Timer()
xttime.Caption = Str$(Year(DateValue(Date$))) + "年" + Str$(Month(DateValue(Date$))) + "月" + Str$(Day(DateValue(Date$))) + "日" + Str$(Hour(Time())) + "时" + Str$(Minute(Time())) + "分" + Str$(Second(Time())) + "秒"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -