📄 stander.frm
字号:
VERSION 5.00
Begin VB.Form stander
BorderStyle = 3 'Fixed Dialog
Caption = "客房标准设置"
ClientHeight = 5565
ClientLeft = 45
ClientTop = 330
ClientWidth = 6735
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5565
ScaleWidth = 6735
ShowInTaskbar = 0 'False
Begin VB.CommandButton Command3
Caption = "删除"
Height = 495
Left = 3600
TabIndex = 17
Top = 4200
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
Left = 960
TabIndex = 16
Top = 600
Width = 1455
End
Begin VB.TextBox Text1
Height = 2175
Index = 3
Left = 4920
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 14
Top = 960
Width = 1455
End
Begin VB.TextBox Text1
Height = 375
Index = 2
Left = 960
TabIndex = 13
Top = 2760
Width = 1455
End
Begin VB.TextBox Text1
Height = 375
Index = 1
Left = 960
TabIndex = 12
Top = 2040
Width = 1455
End
Begin VB.TextBox Text1
Height = 375
Index = 0
Left = 960
TabIndex = 11
Top = 1320
Width = 1455
End
Begin VB.CheckBox Check1
Caption = "有无卫生间"
Height = 495
Index = 3
Left = 3240
TabIndex = 10
Top = 2640
Width = 1215
End
Begin VB.CheckBox Check1
Caption = "有无电视"
Height = 255
Index = 2
Left = 3240
TabIndex = 9
Top = 2040
Width = 1215
End
Begin VB.CheckBox Check1
Caption = "有无电话"
Height = 495
Index = 1
Left = 3240
TabIndex = 8
Top = 1200
Width = 1215
End
Begin VB.CheckBox Check1
Caption = "有无空调"
Height = 495
Index = 0
Left = 3240
TabIndex = 7
Top = 480
Width = 1215
End
Begin VB.CommandButton Command4
Caption = "返回"
Height = 495
Left = 5280
TabIndex = 2
Top = 4200
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "更新"
Height = 495
Left = 2040
TabIndex = 1
Top = 4200
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "添加"
Height = 495
Left = 480
TabIndex = 0
Top = 4200
Width = 1215
End
Begin VB.Label Label1
Caption = "备注"
Height = 375
Index = 1
Left = 5040
TabIndex = 15
Top = 600
Width = 615
End
Begin VB.Label Label1
Caption = "面积"
Height = 255
Index = 5
Left = 360
TabIndex = 6
Top = 2160
Width = 495
End
Begin VB.Label Label1
Caption = "单价"
Height = 255
Index = 4
Left = 360
TabIndex = 5
Top = 2760
Width = 495
End
Begin VB.Label Label1
Caption = "床位数"
Height = 375
Index = 2
Left = 240
TabIndex = 4
Top = 1440
Width = 615
End
Begin VB.Label Label1
Caption = "客房标准"
Height = 375
Index = 0
Left = 120
TabIndex = 3
Top = 600
Width = 855
End
End
Attribute VB_Name = "stander"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mydb As Database
Dim mydb1 As Database
Dim myrs As Recordset
Dim myrs1 As Recordset
Dim sql As String
Private Sub Combo1_Change()
Combo1_Click
End Sub
Private Sub Combo1_Click()
Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
Set myrs1 = mydb1.OpenRecordset("客房标准", dbOpenDynaset)
myrs1.FindFirst "客房标准 = " + Chr(34) + Combo1.Text + Chr(34) + ""
For i = 0 To 2
Text1(i).Text = myrs1.Fields(i + 1)
Next
For i = 0 To 3
If myrs1.Fields(i + 4) = "无" Then
Check1(i) = 0
Else
Check1(i) = 1
End If
Next
Text1(3).Text = myrs1.Fields(8)
myrs1.Close
mydb1.Close
End Sub
Private Sub Command1_Click()
If Combo1.Text = "" Then
k = 1
GoTo questions
End If
For j = 0 To 2
If Text1(j).Text = "" Then
k = j + 2
GoTo questions
End If
Next
For j = 0 To 2
If Not IsNumeric(Text1(j).Text) Then
k = j + 5
GoTo questions
End If
Next
Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
Set myrs = mydb.OpenRecordset("客房标准", dbOpenDynaset)
myrs.FindFirst "客房标准 = " + Chr(34) + Combo1.Text + Chr(34) + ""
If myrs.NoMatch Then
myrs.AddNew
myrs.Fields(0) = Combo1.Text
For i = 0 To 2
myrs.Fields(i + 1) = Text1(i).Text
Next
For i = 0 To 3
If Check1(i) = 1 Then
myrs.Fields(i + 4) = "有"
Else
myrs.Fields(i + 4) = "无"
End If
Next
If Text1(3).Text <> "" Then myrs.Fields(8) = Text1(3).Text
myrs.Update
MsgBox ("客房标准添加成功！")
Combo1.AddItem (Combo1.Text)
Else
MsgBox ("此标准已经存在，不能添加！"), 48, "警告"
End If
myrs.Close
mydb.Close
questions:
Select Case k
Case 1
MsgBox ("客房编号不为空！"), 48, "警告"
Combo1.SetFocus
Case 2
MsgBox ("床位数不为空！"), 48, "警告"
Text1(0).SetFocus
Case 3
MsgBox ("面积不为空！"), 48, "警告"
Text1(1).SetFocus
Case 4
MsgBox ("单价不为空！"), 48, "警告"
Text1(2).SetFocus
Case 5
MsgBox ("床位数不为数字！"), 48, "警告"
Text1(0).SetFocus
Case 6
MsgBox ("面积不为数字！"), 48, "警告"
Text1(1).SetFocus
Case 7
MsgBox ("单价不为数字！"), 48, "警告"
Text1(2).SetFocus
End Select
End Sub
Private Sub Command2_Click()
If Combo1.Text = "" Then
k = 1
GoTo questions
End If
For j = 0 To 2
If Text1(j).Text = "" Then
k = j + 2
GoTo questions
End If
Next
For j = 0 To 2
If Not IsNumeric(Text1(j).Text) Then
k = j + 5
GoTo questions
End If
Next
Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
Set myrs = mydb.OpenRecordset("客房标准", dbOpenDynaset)
myrs.FindFirst "客房标准 = " + Chr(34) + Combo1.Text + Chr(34) + ""
If Not myrs.NoMatch Then
myrs.Edit
myrs.Fields(0) = Combo1.Text
For i = 0 To 2
myrs.Fields(i + 1) = Text1(i).Text
Next
For i = 0 To 3
If Check1(i) = 1 Then
myrs.Fields(i + 4) = "有"
Else
myrs.Fields(i + 4) = "无"
End If
Next
If Text1(3).Text <> "" Then myrs.Fields(8) = Text1(3).Text
myrs.Update
MsgBox ("客房标准更新成功！")
Else
MsgBox ("此标准不存在，不能更新！"), 48, "警告"
End If
myrs.Close
mydb.Close
questions:
Select Case k
Case 1
MsgBox ("客房编号不为空！"), 48, "警告"
Combo1.SetFocus
Case 2
MsgBox ("床位数不为空！"), 48, "警告"
Text1(0).SetFocus
Case 3
MsgBox ("面积不为空！"), 48, "警告"
Text1(1).SetFocus
Case 4
MsgBox ("单价不为空！"), 48, "警告"
Text1(2).SetFocus
Case 5
MsgBox ("床位数不为数字！"), 48, "警告"
Text1(0).SetFocus
Case 6
MsgBox ("面积不为数字！"), 48, "警告"
Text1(1).SetFocus
Case 7
MsgBox ("单价不为数字！"), 48, "警告"
Text1(2).SetFocus
End Select
End Sub
Private Sub Command3_Click()
Dim MESSAGE As String
Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
Set myrs = mydb.OpenRecordset("客房标准", dbOpenDynaset)
myrs.FindFirst "客房标准 = " + Chr(34) + Combo1.Text + Chr(34) + ""
If Not myrs.NoMatch Then
MESSAGE = MsgBox("确定删除吗？", 1, "删除")
If MESSAGE = vbOK Then
myrs.Delete
myrs.MoveNext
myrs.Close
Combo1.RemoveItem Combo1.ListIndex
MsgBox ("客房标准删除成功！")
End If
Else
MsgBox ("此标准不存在，不能删除！"), 48, "警告"
End If
mydb.Close
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Load()
left = 100
Top = 100
Combo1.Clear
Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb") '设置数据库
sql = "select 客房标准 from 客房标准"
Set myrs = mydb.OpenRecordset(sql)
If myrs.EOF = False Then myrs.MoveLast
If myrs.BOF = False Then myrs.MoveFirst
For i = 0 To myrs.RecordCount - 1
Combo1.AddItem (myrs.Fields(0))
myrs.MoveNext
Next i
If Combo1.ListCount > 0 Then Combo1.ListIndex = 0
myrs.Close
mydb.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -