📄 pool2.frm
字号:
Begin VB.Label lblChargeNo
Alignment = 2 'Center
BackColor = &H00FFC0C0&
BorderStyle = 1 'Fixed Single
Caption = "charge_no"
Height = 375
Left = 6240
TabIndex = 10
Top = 6960
Width = 1095
End
Begin VB.Label lblGNo
Alignment = 2 'Center
BackColor = &H00C0FFC0&
BorderStyle = 1 'Fixed Single
Caption = "guest_no"
Height = 375
Left = 3840
TabIndex = 9
Top = 6960
Width = 1095
End
Begin VB.Label lblORNo
Alignment = 2 'Center
BackColor = &H0080FF80&
BorderStyle = 1 'Fixed Single
Caption = "or_no"
Height = 375
Left = 3840
TabIndex = 8
Top = 7440
Width = 1095
End
Begin VB.Label lblroomno
Alignment = 2 'Center
BackColor = &H00FFFFC0&
BorderStyle = 1 'Fixed Single
Caption = "room_no"
Height = 375
Left = 5040
TabIndex = 7
Top = 6960
Width = 1095
End
Begin VB.Label totalcharj
Alignment = 2 'Center
BackColor = &H00FFFF80&
BorderStyle = 1 'Fixed Single
Caption = "totalcharj"
Height = 375
Left = 5040
TabIndex = 6
Top = 7440
Width = 1095
End
Begin VB.Label lbldate
Alignment = 2 'Center
BackColor = &H0080FFFF&
BorderStyle = 1 'Fixed Single
Caption = "date"
Height = 375
Left = 2640
TabIndex = 5
Top = 7440
Width = 1095
End
Begin VB.Label lblTP
Alignment = 2 'Center
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Caption = "toTaL"
ForeColor = &H00C00000&
Height = 375
Left = 2640
TabIndex = 4
Top = 6960
Width = 1095
End
End
Attribute VB_Name = "Pool2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public bar As String
Public dept As String
Public o As Integer
Public c As Integer
Dim ar As Integer
Dim tp As Integer
Dim Change As Integer
Dim totcharj As Integer
Dim datenow As String
Dim TransType As String
Private Sub cboRoomNo_Click()
check_RS
rs.Open "select * from room_transaction where room_no = " & cboRoomNo, Cnn
tot.Caption = rs(5)
totcharj = rs(5) + lblTP
totalcharj.Caption = totcharj
Command1.Enabled = True
End Sub
Private Sub Combo1_Click()
check_RS
rs.Open "select * from room_transaction where room_no = " & Combo1, Cnn
tot.Caption = rs(5)
totcharj = rs(5) + lblTP
totalcharj.Caption = totcharj
Command1.Enabled = True
End Sub
Private Sub Command1_Click()
If bar = "payment" Then
check_RStemp
rstemp.Open "select * from payment", Cnn
'================
Cnn.Execute "INSERT INTO payment (OR_no, trans_code, trans_no, date_paid, total) VALUES (" & _
lblORNo.Caption & ", '" & Label12.Caption & _
"', '" & Label11.Caption & "', '" & lbldate.Caption & "', '" & lblTP.Caption & "')" '
'================
Unload Me
Unload frmPool
ElseIf bar = "charge" Then
If Combo1 = "" Then
Command1.Enabled = False
Else
check_RS
rs.Open "select * from charges", Cnn
Cnn.Execute "INSERT INTO charges (charge_no, room_trans_no, trans_code, trans_no, amount, charge_date) VALUES (" & c & ", '" & lblGNo & _
"', '" & Label12 & "', '" & Label11 & "', '" & lblTP & "', '" & lbldate & "')"
'================
check_RS1
rs1.Open "select * from room_transaction", Cnn
Cnn.Execute "update room_transaction set total_charges = " & totalcharj.Caption & " where room_no = " & Combo1.Text
'================
End If
Unload Me
Unload frmPool
ElseIf bar = "c" Then
If txtName = "" Then
MsgBox "Please enter the Reference Name of the person who charges...", vbInformation, "HMS"
Command1.Enabled = False
Else
check_RS
rs.Open "select * from charges", Cnn
Cnn.Execute "INSERT INTO charges (charge_no, room_trans_no, trans_code, trans_no, reference_name, amount, charge_date) VALUES (" & c & ", '" & lblGNo & _
"', '" & Label12 & "', '" & Label11 & "' , '" & txtName & "', '" & lblTP & "', '" & lbldate & "')"
'=================
check_RS1
rs1.Open "select * from room_transaction", Cnn
Cnn.Execute "update room_transaction set total_charges = " & totalcharj.Caption & " where room_no = " & cboRoomNo.Text
Unload Me
Unload frmPool
End If
End If
rs.Requery 1
End Sub
Private Sub Command2_Click()
If MsgBox("Are you sure do you want to cancel this transaction, All details will be deleted. ", vbYesNo) = vbYes Then
Cnn.Execute "delete * from pool_details where pool_trans_no = " & txtsearch
Cnn.Execute "delete * from pool where pool_trans_no = " & txtsearch
rs.Requery 1
Unload Pool2
frmPool.Command1.Caption = "<< Cancel <<"
frmPool.cboGuestType.Visible = True
frmPool.lvtran.ListItems.Clear
frmPool.Label99.Caption = ""
frmPool.total = 0
frmPool.Gtotal = 0
End If
End Sub
Private Sub Command3_Click()
Dim tempQ As String
If MsgBox("Are you sure do you want to delete swimmingpool no " & lvtran.SelectedItem.SubItems(1), vbYesNo) = vbYes Then
Cnn.Execute "delete from pool_details where swimmingpool_no = " & lvtran.SelectedItem.ListSubItems(1)
tempQ = Val(lblTP.Caption) - Val(lvtran.SelectedItem.ListSubItems(4))
Cnn.Execute "update pool set total = " & tempQ & " where pool_trans_no = " & lvtran.SelectedItem.Text
rs.Requery 1
fillDetails
lblTP = tempQ
Label9 = tempQ
End If
End Sub
Private Sub fillDetails()
On Error GoTo HELL
lvtran.ListItems.Clear
lvtran.Refresh
Dim i As Integer
i = 1
While Not rs.EOF
lvtran.Refresh
lvtran.ListItems.Add
lvtran.ListItems(i).Text = rs(0).Value
'===========
'check_RStemp
'rstemp.Open "select description from swimmingpool where swimmingpool_no = " & rs(1), Cnn
'lvtran.ListItems(i).SubItems(1) = rstemp(0)
'===========
lvtran.ListItems(i).SubItems(1) = rs(1).Value
check_RStemp
rstemp.Open "select price from swimmingpool where swimmingpool_no = " & rs(1), Cnn
lvtran.ListItems(i).SubItems(2) = rstemp(0)
'===========
lvtran.ListItems(i).SubItems(3) = rs(2).Value
lvtran.ListItems(i).SubItems(4) = rs(3).Value
'Label9 = FormatNumber(TotalAmount)
i = i + 1
rs.MoveNext
HELL:
Wend
End Sub
Private Sub Form_Load()
TransType = "Pool"
datenow = Format(Date, "mmdd")
ar = 0
tp = 0
Change = 0
totcharj = 0
'=========
check_RS
rs.Open "Select * from pool_details", Cnn
fill2
'=========
c = 1
check_RS2
rs2.Open "select * from charges", Cnn
'=========
While Not rs2.RecordCount = 0
check_RS2
c = c + 1
rs2.Open "select * from charges where charge_no = " & c, Cnn
Wend
lblChargeNo = c
'=========
check_RS
rs.Open "select * from transaction_type", Cnn
While Not rs.EOF
If TransType = rs!Description Then
Label12.Caption = rs!trans_code
rs.MoveLast
rs.MoveNext
Else
rs.MoveNext
End If
Wend
'=========
Option1.Value = True
Option2.Value = False
Option3.Value = True
Command1.Enabled = True
lbldate = Date
bar = "payment"
End Sub
Private Sub fill2()
On Error GoTo HELL
lvtran.ListItems.Clear
lvtran.Refresh
Dim i As Integer
i = 1
While Not rs.EOF
lvtran.Refresh
lvtran.ListItems.Add
lvtran.ListItems(i).Text = rs(0).Value
'===========
'check_RStemp
'rstemp.Open "select description from swimmingpool where swimmingpool_no = " & rs(1), Cnn
'lvtran.ListItems(i).SubItems(1) = rstemp(0)
'===========
lvtran.ListItems(i).SubItems(1) = rs(1).Value
check_RStemp
rstemp.Open "select price from swimmingpool where swimmingpool_no = " & rs(1), Cnn
lvtran.ListItems(i).SubItems(2) = rstemp(0)
'===========
lvtran.ListItems(i).SubItems(3) = rs(2).Value
lvtran.ListItems(i).SubItems(4) = rs(3).Value
'Label9 = FormatNumber(TotalAmount)
i = i + 1
rs.MoveNext
HELL:
Wend
End Sub
Private Sub fill22()
lv.ListItems.Clear
lv.Refresh
Dim i As Integer
i = 1
While Not rs.EOF
lv.Refresh
lv.ListItems.Add
lv.ListItems(i).Text = rs(0).Value
lv.ListItems(i).SubItems(1) = rs(1).Value
lv.ListItems(i).SubItems(2) = rs(2).Value
lv.ListItems(i).SubItems(3) = rs(3).Value
i = i + 1
rs.MoveNext
Wend
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.key
Case "SAVE"
If bar = "payment" Then
check_RStemp
rstemp.Open "select * from payment", Cnn
'================
Cnn.Execute "INSERT INTO payment (OR_no, trans_code, trans_no, date_paid, total) VALUES (" & _
lblORNo.Caption & ", '" & Label12.Caption & _
"', '" & Label11.Caption & "', '" & lbldate.Caption & "', '" & lblTP.Caption & "')" '
'================
ElseIf bar = "charge" Then
If txtName = "" Then
MsgBox "Please enter the name of the person who charges...", vbInformation, "HMS"
Toolbar1.Buttons(2).Enabled = False
Else
check_RS
rs.Open "select * from charges", Cnn
Cnn.Execute "INSERT INTO charges (charge_no, charge_date, guest_no, trans_type, amount, name) VALUES (" & c & ", '" & lbldate & _
"', '" & Label10 & "', '" & Label7 & "', '" & lblTP & "', '" & txtName & "')"
check_RS1
rs1.Open "select * from room_transaction", Cnn
Cnn.Execute "update room_transaction set charges = " & totalcharj.Caption & " where room_no = " & lblroomno.Caption
End If
End If
rs.Requery 1
Unload Me
End Select
End Sub
Private Sub lvtran_DblClick()
Dim tempQ As String
Cnn.Execute "delete from pool_details where swimmingpool_no = " & lvtran.SelectedItem.ListSubItems(1)
tempQ = Val(lblTP.Caption) - Val(lvtran.SelectedItem.ListSubItems(4))
'===========
Cnn.Execute "update pool set total = " & tempQ & " where pool_trans_no = " & lvtran.SelectedItem.Text
Unload Pool2
frmPool.Command2.Visible = True
frmPool.Label9.Caption = tempQ
frmPool.total = tempQ
frmPool.Gtotal = tempQ
bar = "back"
End Sub
Private Sub Option1_Click()
bar = "payment"
Frame1.Visible = True
Combo1.Clear
cboRoomNo.Clear
Command1.Enabled = True
txtName.Text = ""
End Sub
Private Sub Option2_Click()
bar = "charge"
Frame4.Visible = True
Frame1.Visible = False
command1Enabled = True
check_RS1
rs1.Open "select * from room_transaction where guest_id = " & txtGID, Cnn
While Not rs1.EOF
Combo1.AddItem (rs1(3))
Combo1 = rs1(3)
rs1.MoveNext
Wend
cboRoomNo.Clear
Command1.Enabled = True
'==========
check_RS
rs.Open "select * from room_transaction where room_no = " & Combo1, Cnn
tot.Caption = rs(5)
totcharj = rs(5) + lblTP
totalcharj.Caption = totcharj
Command1.Enabled = True
End Sub
Private Sub Option3_Click()
bar = "c"
Frame2.Visible = True
Frame1.Visible = False
Frame4.Visible = False
check_RS1
rs1.Open "select * from room_transaction", Cnn
While Not rs1.EOF
cboRoomNo.AddItem (rs1(3))
rs1.MoveNext
Wend
Combo1.Clear
Command1.Enabled = False
cboRoomNo.Enabled = False
End Sub
Private Sub txtGID_Change()
check_RStemp
rstemp.Open "select * from guest where guest_id = " & txtGID, Cnn
Label4 = rstemp(1) & ", " & rstemp(2) & " " & rstemp(3) & "."
End Sub
Private Sub txtName_Change()
If txtName.Text = "" Or txtName.Text = " " Or txtName.Text = " " Or txtName.Text = " " Or txtName.Text = " " Then
cboRoomNo.Enabled = False
Command1.Enabled = False
cboRoomNo.Text = ""
Else: cboRoomNo.Enabled = True
End If
End Sub
Private Sub txtsearch_Change()
On Error GoTo nad
If txtsearch = "" Or rs.RecordCount = 0 Then
check_RS
rs.Open "select * from pool_details", Cnn
fill2
Else
check_RS
rs.Open "select * from pool_details where pool_trans_no = " & txtsearch, Cnn
fill2
check_RS1
rs1.Open "select * from pool where pool_trans_no = " & txtsearch, Cnn
If rs1.RecordCount <> 0 Then
lblTP = rs1(3)
lblGNo = rs1(1)
Label11 = rs1(0)
Label9 = FormatNumber(rs1(3))
lblORNo = datenow & rs1(0) & Label12
check_RS2
rs2.Open "select * from room_transaction where room_trans_no = " & lblGNo, Cnn
txtGID = rs2(2)
Label15 = rs2(3)
'=========
End If
End If
nad:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -