📄 frmreshpcadd.frm
字号:
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 + -