⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pool2.frm

📁 Call centeer gestion de usuarios todo ello gratis y bajo windows
💻 FRM
📖 第 1 页 / 共 2 页
字号:
   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 + -