frmpool.frm

Call centeer gestion de usuarios todo ello gratis y bajo windows

         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   8760
      TabIndex        =   20
      Top             =   2280
      Width           =   1095
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00FF8080&
      Height          =   405
      Left            =   2040
      Top             =   4800
      Width           =   4455
   End
   Begin VB.Label Label9 
      BackColor       =   &H00C0C0FF&
      Caption         =   "Label9"
      BeginProperty Font 
         Name            =   "Century Gothic"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   8760
      TabIndex        =   4
      Top             =   1920
      Width           =   1095
   End
   Begin VB.Label Label99 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   6840
      TabIndex        =   3
      Top             =   7560
      Width           =   1695
   End
   Begin VB.Label Label8 
      Caption         =   "Total"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   6120
      TabIndex        =   2
      Top             =   7560
      Width           =   735
   End
   Begin VB.Label Label7 
      Caption         =   "Note! All Guest are FREE from pool, No amount to be paid.."
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   2160
      TabIndex        =   1
      Top             =   4920
      Width           =   4215
   End
   Begin VB.Label Label5 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Transaction No."
      BeginProperty Font 
         Name            =   "Monotype Corsiva"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00008000&
      Height          =   735
      Left            =   -480
      TabIndex        =   0
      Top             =   0
      Width           =   3135
   End
End
Attribute VB_Name = "frmPool"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public sw1, seed, eks, way, a, b, c, d, e, f, G, beat, X, z As Integer
Public ptn As Integer
Public Gtotal As Currency
Public total As Currency
Public price As String
Public people As String
Dim datenow As String
Dim TransType As String


Private Sub cboGuestType_Click()
If cboGuestType.ListIndex = 1 Then
   Label11.Caption = "Walk-In"
   txtGuestNo = ""
   lblRTN = "0"
   l.Enabled = False
   lblRoomNo.Caption = ""
   price = "Yes"
   Label7.Visible = False
   Shape2.Visible = False
Else: Label11 = ""
   lblRTN = ""
   l.Enabled = True
   price = "Free"
   Label7.Visible = True
   Shape2.Visible = True
End If
End Sub

Private Sub Command1_Click()
If Command1.Caption = "<< Cancel <<" Then
   Unload Me
ElseIf Command1.Caption = ">> Proceed >>" Then
If Pool2.bar = "back" Then
Cnn.Execute "update pool set total = " & Label9 & " where pool_trans_no = " & Label1
Pool2.txtsearch = ptn
Pool2.Label9 = Label9
End If
'Else
cboGuestType.Visible = True
l.Enabled = True
check_RS1
rs1.Open "select * from pool where pool_trans_no = " & ptn, Cnn
If rs1.RecordCount = 0 Then
Cnn.Execute "INSERT INTO pool (pool_trans_no, room_trans_no, trans_date, total) VALUES (" & ptn & ", '" & lblRTN & _
"', '" & Label4.Caption & "', '" & Label9.Caption & "')"      '
End If
Pool2.txtsearch = ptn
Pool2.Label9 = Label9
Load Pool2
Pool2.Show 1
'Unload Me
End If
'End If
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 = " & Label1
Cnn.Execute "delete * from pool where pool_trans_no = " & Label1
rs.Requery 1
Unload frmPool
End If
End Sub

Private Sub Form_Load()
price = "Free"
TransType = "Pool"
datenow = Format(Date, "mmdd")
total = 0
Gtotal = 0
check_RS
rs.Open "select * from swimmingpool order by swimmingpool_no asc", Cnn
fill
'========
ptn = 1
check_RS1
rs1.Open "select * from pool_details " & txtGuestNo, Cnn

While Not rs1.RecordCount = 0
 check_RS1
 ptn = ptn + 1
 rs1.Open "select * from pool_details where pool_trans_no = " & ptn, Cnn
Wend
' Label5 = "Transaction No& ptn"
 Label1 = ptn
 '===========
check_RS2
rs2.Open "select * from room_transaction order by room_trans_no", Cnn
fillrt
'=============
check_RS
rs.Open "select * from transaction_type", Cnn
While Not rs.EOF
If TransType = rs!Description Then
    Label6.Caption = rs!trans_code
    rs.MoveLast
    rs.MoveNext
Else
    rs.MoveNext
End If
Wend
Label12 = datenow & ptn & Label6
Label4 = Date
Command1.Caption = "<< Cancel <<"
End Sub

Public Sub fill()
Dim X As Integer
    lv.ListItems.Clear
check_RS
rs.Open "select * from swimmingpool order by swimmingpool_no asc", Cnn
While Not rs.EOF
  Set lst = lv.ListItems.Add(, , rs(0), , 1)
For X = 1 To 2
   lst.SubItems(X) = rs(X)
Next X
rs.MoveNext
Wend
End Sub





Private Sub l_Click()
On Error GoTo r
check_RS
rs.Open "select * from room_transaction order by room_trans_no asc", Cnn
While Not rs.EOF
If l.SelectedItem.Text = rs!room_trans_no Then
    lblRTN.Caption = rs!room_trans_no
    Label11.Caption = rs!guest_id
    lblRoomNo.Caption = rs!room_no
    rs.MoveLast
    rs.MoveNext
Else
    rs.MoveNext
End If
Wend
r:
End Sub


Private Sub lv_DblClick()
'On Error GoTo c
Dim tempQTY As String
Dim tempNUM, tempQ As String
If Label11.Caption = "" Then
MsgBox "Please choose a customer...", vbInformation, "HMS"
Exit Sub
End If
'==========
If price = "Free" Then
   price = 0
   people = 1
Cnn.Execute "insert into pool_details values(" & ptn & ",'" & lv.SelectedItem.Text & "'," & _
people & "," & price & ")"
'===========
check_RS1
rs1.Open "select * from pool where pool_trans_no = " & ptn, Cnn
If rs1.RecordCount = 0 Then
Cnn.Execute "INSERT INTO pool (pool_trans_no, room_trans_no, trans_date, total) VALUES (" & ptn & ", '" & lblRTN.Caption & _
"', '" & Label4.Caption & "', '" & price & "')"
'===========
End If
check_RS
rs.Open "select * from payment", Cnn
Cnn.Execute "INSERT INTO payment (OR_no, trans_code, trans_no, date_paid, total) VALUES (" & Label12 & ", '" & Label6 & _
"', '" & ptn & "', '" & Label4 & "', '" & price & "')"
MsgBox "All guest are FREE from pool, No amount to be paid", vbInformation, "HMS"
Unload frmPool
'End If
ElseIf price = "Yes" Then
tempQTY = "0"
While Val(tempQTY) > Val(lv.SelectedItem.SubItems(2)) Or tempQTY = "0" Or IsNumeric(tempQTY) = False
'==========
tempQTY = InputBox("Please enter the number of people.. ", lv.SelectedItem.ListSubItems(1))
'==========
If tempQTY = "" Then
Exit Sub
End If
Wend
'===========
total = Val(tempQTY) * Val(lv.SelectedItem.ListSubItems(2))
Gtotal = Gtotal + total
'===========
Cnn.Execute "insert into pool_details values(" & ptn & ",'" & lv.SelectedItem.Text & "'," & _
tempQTY & "," & total & ")"
'===========
fill2
rs.Requery 1
fill
Command1.Caption = ">> Proceed >>"
l.Enabled = False
cboGuestType.Visible = False
'===========
If MsgBox("Add another? ", vbYesNo, "?") = vbNo Then
If Pool2.bar = "back" Then
Cnn.Execute "update pool set total = " & Label9 & " where pool_trans_no = " & Label1
Pool2.txtsearch = ptn
Pool2.Label9 = Label9
End If
'Else
cboGuestType.Visible = True
l.Enabled = True
check_RS1
rs1.Open "select * from pool where pool_trans_no = " & ptn, Cnn
If rs1.RecordCount = 0 Then
Cnn.Execute "INSERT INTO pool (pool_trans_no, room_trans_no, trans_date, total) VALUES (" & ptn & ", '" & lblRTN & _
"', '" & Label4.Caption & "', '" & Label9.Caption & "')"      '
End If
Pool2.txtsearch = ptn
Pool2.Label9 = Label9
Load Pool2
Pool2.Show 1
'Unload Me
End If
End If
End Sub
Private Sub fill2()
check_RS
rs.Open "select * from pool_details where pool_trans_no = " & ptn, Cnn
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(1).Value
'===========
check_RStemp
rstemp.Open "select description from swimmingpool where swimmingpool_no = " & rs(1), Cnn
lvtran.ListItems(i).SubItems(1) = rstemp(0)
'===========
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
Label99 = FormatNumber(Gtotal)
Label9 = Gtotal

i = i + 1
rs.MoveNext
HELL:
Wend
End Sub

Public Sub fill22()
Dim X As Integer
l.ListItems.Clear

check_RStemp
rstemp.Open "select * from pool_details where pool_trans_no = " & ptn, Cnn
While Not rstemp.EOF

Set lst = l.ListItems.Add(, , rstemp(0), , 1)
For X = 1 To 3
     lst.SubItems(X) = rstemp(X)
     Next X
rstemp.MoveNext
Wend
Set lst = l.ListItems.Add(, , "")
  lst.SubItems(2) = "Total "
  lst.SubItems(3) = Gtotal
End Sub

Private Sub Timer1_Timer()
If sw1 = 0 Then
  If seed >= 800 Then
    sw1 = 1
     
  Else
seed = seed + 10
  End If
ElseIf sw1 = 1 Then
  If seed <= 65 Then
    sw1 = 0
    
  Else
seed = seed - 10
  End If
End If
Shape2.BorderColor = seed
Label7.ForeColor = seed
End Sub

Private Sub Timer2_Timer()
Label3 = Time
End Sub
Private Sub fillrt()
check_RS2
rs2.Open "select * from room_transaction", Cnn
On Error GoTo HELL
l.ListItems.Clear
l.Refresh
Dim i As Integer
i = 1
While Not rs2.EOF
l.Refresh
l.ListItems.Add
l.ListItems(i).Text = rs2(0).Value
l.ListItems(i).SubItems(1) = rs2(3).Value
l.ListItems(i).SubItems(2) = rs2(2).Value
'l.ListItems(i).SubItems(3) = rs2(2).Value
'===========
check_RStemp
rstemp.Open "select last_name, first_name, mi from guest where guest_id = " & rs2(2), Cnn
l.ListItems(i).SubItems(3) = rstemp(0) & ", " & rstemp(1) & " " & rstemp(2) & ". "
i = i + 1
rs2.MoveNext
HELL:
Wend
End Sub