📄 frmcash.frm
字号:
VERSION 5.00
Begin VB.Form frmCash
BorderStyle = 3 'Fixed Dialog
Caption = "付款平台"
ClientHeight = 4275
ClientLeft = 45
ClientTop = 330
ClientWidth = 6330
Icon = "frmCash.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4275
ScaleWidth = 6330
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.ComboBox cmbPayMethod
Height = 300
ItemData = "frmCash.frx":08CA
Left = 3405
List = "frmCash.frx":08CC
Style = 2 'Dropdown List
TabIndex = 3
Top = 2310
Width = 1470
End
Begin VB.ComboBox cmbDZ
Height = 300
ItemData = "frmCash.frx":08CE
Left = 4125
List = "frmCash.frx":08F3
Style = 2 'Dropdown List
TabIndex = 4
Top = 1545
Visible = 0 'False
Width = 750
End
Begin VB.TextBox txtZL
BackColor = &H00E0E0E0&
Enabled = 0 'False
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 315
IMEMode = 3 'DISABLE
Left = 2025
Locked = -1 'True
TabIndex = 2
Top = 2670
Width = 2850
End
Begin VB.TextBox txtSK
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
IMEMode = 3 'DISABLE
Left = 2025
MaxLength = 8
TabIndex = 1
Top = 2295
Width = 2850
End
Begin VB.TextBox txtFK
BackColor = &H00E0E0E0&
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 315
IMEMode = 3 'DISABLE
Left = 2025
Locked = -1 'True
TabIndex = 5
Top = 1920
Width = 2850
End
Begin VB.TextBox txtJE
BackColor = &H00E0E0E0&
BeginProperty Font
Name = "Arial"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 315
IMEMode = 3 'DISABLE
Left = 2025
Locked = -1 'True
TabIndex = 10
Top = 1170
Width = 2850
End
Begin VB.TextBox txtCardNO
Height = 315
IMEMode = 3 'DISABLE
Left = 2025
MaxLength = 38
PasswordChar = "*"
TabIndex = 0
Top = 1545
Width = 2850
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "找零："
Height = 180
Index = 3
Left = 1425
TabIndex = 6
Top = 2745
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "收款："
Height = 180
Index = 2
Left = 1425
TabIndex = 7
Top = 2355
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "实收金额："
Height = 180
Index = 1
Left = 1065
TabIndex = 11
Top = 1980
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "消费合计："
Height = 180
Index = 0
Left = 1050
TabIndex = 9
Top = 1230
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "卡号："
Height = 180
Left = 1410
TabIndex = 8
Top = 1605
Width = 540
End
End
Attribute VB_Name = "frmCash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmbDZ_Click()
'On Error Resume Next
If txtCardNO.Text <> "" Then
txtFK.Text = Val(txtJE.Text) * Val(cmbDZ.Text) / 100 '打折
txtSK.SetFocus
End If
End Sub
Private Sub cmbPayMethod_Change()
SaveSetting App.EXEName, "Option", "PayMethod", cmbPayMethod.ListIndex
End Sub
Private Sub cmbPaymethod_Click()
SaveSetting App.EXEName, "Option", "PayMethod", cmbPayMethod.ListIndex
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdPay_Click()
'On Error Resume Next
'检验收款是否正确
If Val(txtSK) = 0 Or Val(txtSK) < Val(txtFK) - 20 Then
MsgBox "对不起，付款不正确，请检查后继续！ " & vbCrLf & vbCrLf & " 付款金额：" & txtFK & "元", vbInformation
txtSK.SetFocus
Exit Sub
ElseIf MsgBox("确认入帐吗？(Y/N) ", vbYesNo + vbInformation) = vbNo Then
Exit Sub
End If
Dim DB As Database
Set DB = OpenDatabase(ConData, False, False, Constr)
'打印函数
Call cmdPrint_Click
'等待
' 事务处理
DBEngine.BeginTrans
Dim SellID As Recordset
'获得最后消费号
Set SellID = DB.OpenRecordset("SellCount", dbOpenDynaset)
If SellID.EOF And SellID.BOF Then
nLast = 1
Else
SellID.MoveLast
nLast = SellID.Fields(0) + 1
End If
SellID.Close
'给出最后时间与上台时间
Dim EF As Recordset
Dim sEXE As String
Set EF = DB.OpenRecordset("tmpSell", dbOpenDynaset)
Dim sTmp As String, sTime1 As Date, sTime2 As Date
sTmp = "座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'"
EF.FindFirst sTmp
If EF.NoMatch Then
MsgBox "上台时间为当前时间？ ", vbInformation
sTime1 = Format(Time(), "Short Time")
Else
sTime1 = EF.Fields("上台时间")
End If
sTmp = ""
sTime2 = Format(Time(), "Short Time") '下台时间
EF.Close
'消费单
sTmp1 = "Insert into SellCount (SiteName,卡号,金额,日期,时间,ID,上台时间,下台时间,付款方式,消费总额) values('" & Trim(frmCustomerForm.cmbSite.Text) & "','" & CardNO & "'," & Val(txtFK.Text) & ",#" & Date & "#," & Val(Time()) & "," & nLast & ",#" & sTime1 & "#,#" & sTime2 & "#,'" & Trim(cmbPayMethod.Text) & "'," & Val(txtJE.Text) & ")"
DB.Execute sTmp1
Dim sSql1 As String, sSql2 As String, sSql3 As String
sSql3 = "Update tmpSell Set ID=" & nLast & " Where 座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'"
DB.Execute sSql3
'更新仓库
Dim HG As Recordset
Dim sTmpCode As String
sTmp1 = ""
Set EF = DB.OpenRecordset("Select * From tmpSell Where 座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'", dbOpenDynaset)
Set HG = DB.OpenRecordset("Select * From StoreList", dbOpenDynaset)
Do While Not EF.EOF
' 减少库存记录，首先查找是否存在库存中，然后更新
sTmpCode = EF.Fields(3).Value
sTmp = "代码='" & sTmpCode & "'"
HG.FindFirst sTmp
If HG.NoMatch Then
'播入记录
sTmp1 = "Insert into StoreList Select Menutype,名称,单位,单价,金额,代码,数量 From tmpSell Where 代码='" & sTmpCode & "'"
DB.Execute sTmp1
sTmp1 = "Update StoreList Set 数量=-(数量),金额=-(金额) Where 代码='" & sTmpCode & "'"
Else
'更新记录
sTmp1 = "Update StoreList Set 数量=数量-" & EF.Fields("数量") & ",金额=金额-" & EF.Fields("金额") & " Where 代码='" & sTmpCode & "'"
End If
DB.Execute sTmp1
EF.MoveNext '记录下翻
Loop
EF.Close
HG.Close
sSql1 = "Insert into SellList Select * From tmpSell Where 座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'"
DB.Execute sSql1
sSql2 = "Delete * From tmpSell Where 座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'"
DB.Execute sSql2
DBEngine.CommitTrans
DB.Close
'清空
frmCustomerForm.ConfigGrid2 Trim(frmCustomerForm.cmbSite.Text)
'御载
Unload Me
Exit Sub
Err_:
MsgBox "未知错误：" & vbCrLf & vbCrLf & err.Description, vbCritical, vbOKOnly
End Sub
Private Sub cmdPrint_Click()
'On Error Resume Next
'打印模块
Dim lRet As Long
Dim bRet As Boolean
bRet = ShellAndWait(App.Path & "\Printer.exe " & "ID=" & Trim(Str(nLast)) & "NO=" & Trim(txtCardNO.Text) & "JE=" & Trim(txtJE.Text) & "FK=" & Trim(txtFK.Text) & "ST=" & Trim(frmCustomerForm.cmbSite.Text) & "US=" & UserText, 1, lRet, "", App.Path)
'Shell App.Path & "\Printer.exe " & "ID=" & Trim(Str(nLast)) & "NO=" & Trim(txtCardNO.Text) & "JE=" & Trim(txtJE.Text) & "FK=" & Trim(txtFK.Text) & "ST=" & Trim(frmCustomerForm.cmbSite.Text), vbNormalFocus
'retVal = ShellExecute(Me.hwnd, "Open", strPrint, 0, 0, 1)
End Sub
Private Sub Form_Load()
txtJE = cJE
txtFK = cJE
cmbDZ.ListIndex = Val(GetSetting(App.EXEName, "Option", "Acount", 10))
CardNO = ""
'配置付款方式
ConfigPayMethod
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.EXEName, "Option", "Acount", cmbDZ.ListIndex
End Sub
Private Sub txtCardNO_Change()
Dim TmpStr As String
TmpStr = GetCardNO(Trim(txtCardNO))
If TmpStr <> "" Then
cmbDZ.Visible = True
txtCardNO.Enabled = False
txtFK = Val(txtJE) * Val(cmbDZ.Text) / 100
txtSK = txtFK
txtSK.SetFocus
End If
End Sub
Private Sub txtCardNO_GotFocus()
SetItFocus txtCardNO
End Sub
Private Sub txtCardNO_KeyDown(KeyCode As Integer, Shift As Integer)
DirectFocus txtCardNO, txtSK, txtSK, txtSK, KeyCode
End Sub
Private Sub txtCardNO_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 57 Then
KeyAscii = 0
End If
End Sub
Private Sub txtFK_Change()
txtSK = txtFK
End Sub
Private Sub txtSK_Change()
txtZL = Val(txtSK) - Val(txtFK)
End Sub
Private Sub txtSK_DblClick()
txtSK = txtFK
txtSK.SelStart = 0
txtSK.SelLength = Len(txtSK)
End Sub
Private Sub txtSK_GotFocus()
SetItFocus txtSK
End Sub
Private Sub txtSK_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
KeyCode = 0
End If
DirectFocus txtCardNO, cmdPay, txtCardNO, txtCardNO, KeyCode
End Sub
Private Sub txtSK_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub
If (KeyAscii < 46 Or KeyAscii > 57) Or KeyAscii = 47 Then
KeyAscii = 0
End If
End Sub
Private Sub txtZL_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdPay.SetFocus
Exit Sub
End If
If KeyAscii = 8 Then
Exit Sub
End If
If (KeyAscii < 46 Or KeyAscii > 57) And KeyAscii <> 47 Then
KeyAscii = 0
End If
End Sub
Private Function GetCardNO(sPM As String) As String
'On Error GoTo Err_dj
sPM = Trim(sPM)
Dim DB As Database, EF As Recordset
Set DB = OpenDatabase(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("Select * From Detail Where 卡号='" & sPM & "'", dbOpenDynaset)
If EF.BOF And EF.EOF Then
GetCardNO = ""
CardNO = ""
Else
GetCardNO = sPM
CardNO = sPM
End If
EF.Close
DB.Close
Exit Function
Err_dj:
MsgBox "给出卡号错误! " & vbCrLf & vbCrLf & err.Description, vbCritical
End Function
Private Sub ConfigPayMethod()
Dim DB As Database, EF As Recordset, HH As Integer
Set DB = OpenDatabase(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("Select * From PayType", dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
If Not IsNull(EF.Fields(1)) Then
cmbPayMethod.AddItem EF.Fields(1).Value
End If
EF.MoveNext
HH = HH + 1
Loop
EF.Close
DB.Close
If HH > 1 Then
cmbPayMethod.ListIndex = GetSetting(App.EXEName, "Option", "PayMethod", 0)
SaveSetting App.EXEName, "Option", "PayMethod", cmbPayMethod.ListIndex
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -