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

📄 frmreshpcadd.frm

📁 Complete Hotel Management System BackEnd Oracle
💻 FRM
📖 第 1 页 / 共 2 页
字号:
      DataField       =   "F_CODE"
      DataSource      =   "adoSeaMenu"
      Height          =   375
      Left            =   3480
      TabIndex        =   1
      Top             =   6480
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.TextBox Text2 
      DataField       =   "F_RATE"
      DataSource      =   "adoSeaMenu"
      Height          =   375
      Left            =   4440
      TabIndex        =   0
      Top             =   6480
      Visible         =   0   'False
      Width           =   735
   End
   Begin MSAdodcLib.Adodc adoSeaMenu 
      Height          =   330
      Left            =   3000
      Top             =   6960
      Visible         =   0   'False
      Width           =   3495
      _ExtentX        =   6165
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   2
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "Provider=MSDAORA.1;Password=tiger;User ID=scott;Persist Security Info=True"
      OLEDBString     =   "Provider=MSDAORA.1;Password=tiger;User ID=scott;Persist Security Info=True"
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   "MENU_HYPARK"
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   178
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin Project1.MarqueeText MarqueeText1 
      Height          =   345
      Left            =   0
      Top             =   7320
      Width           =   12255
      _extentx        =   21616
      _extenty        =   529
      backcolor       =   128
      backstyle       =   0
      font            =   "frmResHPCAdd.frx":0258
      forecolor       =   65535
      text            =   "Adding records to Hyde Park Cave restaurant account "
   End
   Begin VB.Image Image4 
      Height          =   1890
      Left            =   -1080
      Picture         =   "frmResHPCAdd.frx":0284
      Top             =   7560
      Width           =   14025
   End
   Begin VB.Image Image1 
      Height          =   240
      Left            =   11760
      Picture         =   "frmResHPCAdd.frx":568D6
      Top             =   120
      Width           =   270
   End
   Begin VB.Label Label12 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Add records!!"
      ForeColor       =   &H0000FFFF&
      Height          =   240
      Left            =   120
      TabIndex        =   37
      Top             =   120
      Width           =   1410
   End
   Begin VB.Image Image2 
      Height          =   360
      Left            =   -3600
      Picture         =   "frmResHPCAdd.frx":56C98
      Top             =   0
      Width           =   17595
   End
   Begin VB.Image Image3 
      Height          =   240
      Left            =   14400
      Picture         =   "frmResHPCAdd.frx":57753
      Top             =   120
      Width           =   270
   End
End
Attribute VB_Name = "frmResHPCAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim adoConn As ADODB.Connection
Dim adoResHPC As ADODB.Recordset
Dim errmsg As String

Private Sub cmdback_Click()
If adoResHPC.EditMode = adEditInProgress Then
  If MsgBox("All unsaved changes would be lost.Proceed anyway?") = vbYes Then
    adoResHPC.CancelUpdate
  Else
    adoResHPC.Update
 End If
End If
MsgBox "Now exiting from application", vbInformation
Set adoResHPC = Nothing
Set adoConn = Nothing
frmResHPCAdd.Visible = False
frmResHydePark.Show
End Sub

Public Function Validate() As Boolean
Dim ret As Boolean
ret = True
errmsg = "Following errors are encountered in your data" + Chr(13) + Chr(13)
If Len(Trim(txtSeaDate.Text)) = 0 Then
    errmsg = errmsg + "* Date cannot be left Blank" + Chr(13)
    ret = False
End If
If Len(Trim(txtSeaCName.Text)) = 0 Then
    errmsg = errmsg + "* Customer Name cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtSeaEmpNo.Text)) = 0 Then
    errmsg = errmsg + "* Employee Number cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtSeaCNo.Text)) = 0 Then
    errmsg = errmsg + "* Customer Number cannot be left blank " + Chr(13)
    ret = False
End If
Validate = ret
End Function

Private Sub cmdSave_Click()
If Validate() = True Then
   adoResHPC.Update
   adoResHPC.MoveLast
   adoResHPC.AddNew
   Clearcontrols
Else
  MsgBox errmsg, vbCritical, "Data entry Errors!!!"
End If
End Sub

Private Sub Form_Load()
MsgBox "Connecting Oracle.Please wait...", vbInformation, "Wait"
Set adoConn = New ADODB.Connection
adoConn.ConnectionString = "Provider=MSDAORA;user id=scott;password=tiger;"
adoConn.CursorLocation = adUseClient
adoConn.Open
Set adoResHPC = New ADODB.Recordset
adoResHPC.CursorType = adOpenDynamic
adoResHPC.LockType = adLockOptimistic
adoResHPC.Open "Res_HPC", adoConn, , , adCmdTable
Set txtSeaDate.DataSource = adoResHPC
txtSeaDate.DataField = "Date_hpc"
Set txtSeaCName.DataSource = adoResHPC
txtSeaCName.DataField = "Cust_Name"
Set txtSeaEmpNo.DataSource = adoResHPC
txtSeaEmpNo.DataField = "Emp_no"
Set comSeaFN1.DataSource = adoResHPC
comSeaFN1.DataField = "Fno1"
Set comSeaFN2.DataSource = adoResHPC
comSeaFN2.DataField = "Fno2"
Set comSeaFN3.DataSource = adoResHPC
comSeaFN3.DataField = "Fno3"
Set txtSeaFName1.DataSource = adoResHPC
txtSeaFName1.DataField = "Fname"
Set txtSeaFName2.DataSource = adoResHPC
txtSeaFName2.DataField = "Fname2"
Set txtSeaFName3.DataSource = adoResHPC
txtSeaFName3.DataField = "Fname3"
Set txtSeaRate1.DataSource = adoResHPC
txtSeaRate1.DataField = "Rate1"
Set txtSeaRate2.DataSource = adoResHPC
txtSeaRate2.DataField = "Rate2"
Set txtSeaRate3.DataSource = adoResHPC
txtSeaRate3.DataField = "Rate3"
Set txtSeaQty1.DataSource = adoResHPC
txtSeaQty1.DataField = "Quant1"
Set txtSeaQty2.DataSource = adoResHPC
txtSeaQty2.DataField = "Quant2"
Set txtSeaQty3.DataSource = adoResHPC
txtSeaQty3.DataField = "Quant3"
Set txtSeaAmt1.DataSource = adoResHPC
txtSeaAmt1.DataField = "Amt1"
Set txtSeaAmt2.DataSource = adoResHPC
txtSeaAmt2.DataField = "Amt2"
Set txtSeaAmt3.DataSource = adoResHPC
txtSeaAmt3.DataField = "Amt3"
Set txtSeaTAmount.DataSource = adoResHPC
txtSeaTAmount.DataField = "Tot_Amount"
adoResHPC.AddNew
End Sub

Private Sub Clearcontrols()
txtSeaDate.Text = ""
txtSeaCName.Text = ""
txtSeaEmpNo.Text = ""
comSeaFN1.Text = ""
comSeaFN2.Text = ""
comSeaFN3.Text = ""
txtSeaFName1.Text = ""
txtSeaFName2.Text = ""
txtSeaFName3.Text = ""
txtSeaRate1.Text = ""
txtSeaRate2.Text = ""
txtSeaRate3.Text = ""
txtSeaQty1.Text = ""
txtSeaQty2.Text = ""
txtSeaQty3.Text = ""
txtSeaAmt1.Text = ""
txtSeaAmt2.Text = ""
txtSeaAmt3.Text = ""
txtSeaTAmount.Text = ""
End Sub

Private Sub txtSeaDate_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtSeaCName_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtSeaFName1_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtSeaFName2_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtSeaFName3_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub

Private Sub cmdCompute_Click()
Dim R1 As Integer, Q1 As Integer, A1 As Integer
Dim R2 As Integer, Q2 As Integer, A2 As Integer
Dim R3 As Integer, Q3 As Integer, A3 As Integer
Dim T As Integer
R1 = Val(txtSeaRate1.Text)
R2 = Val(txtSeaRate2.Text)
R3 = Val(txtSeaRate3.Text)
Q1 = Val(txtSeaQty1.Text)
Q2 = Val(txtSeaQty2.Text)
Q3 = Val(txtSeaQty3.Text)
A1 = R1 * Q1
A2 = R2 * Q2
A3 = R3 * Q3
T = A1 + A2 + A3
txtSeaAmt1.Text = "QR." & Str$(A1)
txtSeaAmt2.Text = "QR." & Str$(A2)
txtSeaAmt3.Text = "QR." & Str$(A3)
txtSeaTAmount.Text = "QR." & Str$(T)
End Sub

Private Sub cmdExit_Click()
If MsgBox("Are you sure you want to exit Hotel Mangement Sytem ?", vbQuestion + vbYesNo, "Confirm Exit !") = vbYes Then
End
End If
End Sub

Private Sub comSeaFN1_Click()
Dim intFcode As Integer
Dim strCriteria As String
Dim varMark As Variant
Dim Found As Boolean
adoSeaMenu.Recordset.MoveFirst
Found = False
If comSeaFN1.Text <> adoSeaMenu.Recordset.Fields("F_code").Value Then
   intFcode = Val(comSeaFN1)
   strCriteria = "F_code =" & intFcode
   adoSeaMenu.Recordset.Find strCriteria, 0, adSearchForward, adBookmarkCurrent
   Do While Not adoSeaMenu.Recordset.EOF
       txtSeaFName1.Text = adoSeaMenu.Recordset.Fields("F_Name").Value
       txtSeaRate1.Text = adoSeaMenu.Recordset.Fields("F_Rate").Value
       varMark = adoSeaMenu.Recordset.Bookmark
       Found = True
       adoSeaMenu.Recordset.Find strCriteria, 1, adSearchForward, varMark
   Loop
Else
   MsgBox "You have entered a invalid Food code.This code is not occupied", vbCritical, "Wrong Entry"
End If
End Sub

Private Sub comSeaFN2_Click()
Dim intFcode As Integer
Dim strCriteria As String
Dim varMark As Variant
Dim Found As Boolean
adoSeaMenu.Recordset.MoveFirst
Found = False
If comSeaFN2.Text <> adoSeaMenu.Recordset.Fields("F_code").Value Then
   intFcode = Val(comSeaFN2)
   strCriteria = "F_code =" & intFcode
   adoSeaMenu.Recordset.Find strCriteria, 0, adSearchForward, adBookmarkCurrent
   Do While Not adoSeaMenu.Recordset.EOF
       txtSeaFName2.Text = adoSeaMenu.Recordset.Fields("F_Name").Value
       txtSeaRate2.Text = adoSeaMenu.Recordset.Fields("F_Rate").Value
       varMark = adoSeaMenu.Recordset.Bookmark
       Found = True
       adoSeaMenu.Recordset.Find strCriteria, 1, adSearchForward, varMark
   Loop
Else
   MsgBox "You have entered a invalid Food code.This code is not occupied", vbCritical, "Wrong Entry"
End If
End Sub

Private Sub comSeaFN3_Click()
Dim intFcode As Integer
Dim strCriteria As String
Dim varMark As Variant
Dim Found As Boolean
adoSeaMenu.Recordset.MoveFirst
Found = False
If comSeaFN3.Text <> adoSeaMenu.Recordset.Fields("F_code").Value Then
   intFcode = Val(comSeaFN3)
   strCriteria = "F_code =" & intFcode
   adoSeaMenu.Recordset.Find strCriteria, 0, adSearchForward, adBookmarkCurrent
   Do While Not adoSeaMenu.Recordset.EOF
       txtSeaFName3.Text = adoSeaMenu.Recordset.Fields("F_Name").Value
       txtSeaRate3.Text = adoSeaMenu.Recordset.Fields("F_Rate").Value
       varMark = adoSeaMenu.Recordset.Bookmark
       Found = True
       adoSeaMenu.Recordset.Find strCriteria, 1, adSearchForward, varMark
   Loop
Else
   MsgBox "You have entered a invalid Food code.This code is not occupied", vbCritical, "Wrong Entry"
End If
End Sub

Private Sub Image1_Click()
If adoResHPC.EditMode = adEditInProgress Then
  If MsgBox("All unsaved changes would be lost.Proceed anyway?") = vbYes Then
    adoResHPC.CancelUpdate
  Else
    adoResHPC.Update
 End If
End If
MsgBox "Now exiting from application", vbInformation
Set adoResHPC = Nothing
Set adoConn = Nothing
frmResHPCAdd.Visible = False
frmResHydePark.Show
End Sub

Private Sub Timer1_Timer()
txtSeaDate.Text = Date
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -