📄 frmcustomerform.frm
字号:
DB.Close
Exit Sub
Err_init:
MsgBox "菜单类型错误,不能为数字 ? " & Err.Description, vbExclamation, "错误:By Yusilong."
End Sub
Private Sub Grid1_DblClick()
If Grid1.Text <> "" Then
If Trim(cmbSite.Text) = "" Then
MsgBox "对不起,请注明该物品的座位号! ", vbInformation, "提示:By Yusilong."
cmbSite.SetFocus
Exit Sub
End If
frmQuantly.Show 1
If SureQuantly = True Then
Dim lCurRow As Long
lCurRow = Grid1.Row '当前行
AddRecord Grid1.TextMatrix(lCurRow, 1), "名称", Grid1.TextMatrix(lCurRow, 2), "单价", Grid1.TextMatrix(lCurRow, 3), "单位", Grid1.TextMatrix(lCurRow, 4), "代码", Grid1.TextMatrix(lCurRow, 5), "MenuType", Grid1.TextMatrix(lCurRow, 2) * sSL, "金额", "tmpSell"
ConfigGrid2 Trim(cmbSite.Text)
End If
Else
Exit Sub
End If
End Sub
Private Sub Grid2_Click()
If Grid2.Text <> "" Then
cmdDel.Enabled = True
Else
cmdDel.Enabled = False
End If
End Sub
Private Sub Grid2_DblClick()
If Grid2.Text <> "" Then
cmdDel.Enabled = True
mnuDel.Enabled = True
Else
cmdDel.Enabled = False
mnuDel.Enabled = False
End If
PopupMenu mnuControl
End Sub
Private Sub Grid2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu mnuControl
End If
End Sub
Private Sub mnuCheck_Click()
cmdPast_Click
End Sub
Private Sub mnuControl_Click()
If Grid2.Text <> "" Then
cmdDel.Enabled = True
mnuDel.Enabled = True
Else
cmdDel.Enabled = False
mnuDel.Enabled = False
End If
End Sub
Private Sub mnuDel_Click()
cmdDel_Click
End Sub
Private Sub mnuExit_Click()
cmdCancel_Click
End Sub
Private Sub Strip1_Click()
'选择类别
sGlobalType = Strip1.SelectedItem.Key
ConfigGrid
End Sub
Private Sub ConfigSite()
On Error GoTo Err_init
Dim DB As Database
Dim EF As Recordset, sEXE As String
Set DB = OpenDatabase(ConData, False, False, Constr)
' SQL语言删除
sEXE = "Select SiteName From SiteType"
Set EF = DB.OpenRecordset(sEXE, dbOpenDynaset)
If EF.EOF And EF.BOF Then
EF.Close
DB.Close
Exit Sub
Else
EF.MoveFirst
Dim X As Integer
X = 0
Do While Not EF.EOF
cmbSite.AddItem EF.Fields(0), X
X = X + 1
EF.MoveNext
Loop
cmbSite.ListIndex = 0 '默认值
End If
EF.Close
DB.Close
If cmbSite.ListCount > 1 Then
cmbSite.ListIndex = 0
End If
Exit Sub
Err_init:
MsgBox "装载(座位)未知错误!" & Err.Description, vbExclamation, "错误:By Yusilong."
End Sub
Private Sub ConfigCode()
On Error GoTo Err_init
Dim DB As Database
Dim EF As Recordset, sEXE As String
Set DB = OpenDatabase(ConData, False, False, Constr)
' SQL语言删除
sEXE = "Select 代码 From EatList"
Set EF = DB.OpenRecordset(sEXE, dbOpenDynaset)
If EF.EOF And EF.BOF Then
EF.Close
DB.Close
Exit Sub
Else
EF.MoveFirst
Dim X As Integer
X = 0
Do While Not EF.EOF
cmbCode.AddItem EF.Fields(0), X
X = X + 1
EF.MoveNext
Loop
'cmbCode.ListIndex = 0 '默认值
End If
EF.Close
DB.Close
Exit Sub
Err_init:
MsgBox "装载(代码)未知错误!" & Err.Description, vbExclamation, "错误:By Yusilong."
End Sub
Private Sub txtSl_Change()
If Trim(cmbCode.Text) <> "" And Trim(cmbSite.Text) <> "" And Val(txtSL) > 0 Then
cmdAdd.Enabled = True
Else
cmdAdd.Enabled = False
End If
End Sub
Private Sub txtSl_GotFocus()
SetItFocus txtSL
End Sub
Public Sub ConfigGrid2(sCod As String)
On Error GoTo Err_init
Grid2.Visible = False
Grid2.Clear
Grid2.Cols = 7
Grid2.FormatString = "^ .. |^ 物品名称 |^ 单价 |^ 单位 |^ 数量 |^ 金额 |上台时间 "
Grid2.ColWidth(0) = 300
Grid2.ColWidth(1) = 1200
Grid2.ColWidth(2) = 700
Grid2.ColWidth(3) = 800
Grid2.ColWidth(4) = 820
Grid2.ColWidth(5) = 1100
Grid2.ColWidth(6) = 1300
Dim sSQL As String
sSQL = "Select * From tmpSell Where 座位='" & sCod & "'"
Dim DB As Database, EF As Recordset, HH As Integer, DelNO As Long
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, tempStr As String, SureStr As String, Qy As Integer
Set DB = OpenDatabase(ConData, False, False, Constr)
Set EF = DB.OpenRecordset(sSQL, dbOpenDynaset)
If EF.EOF And EF.BOF Then
DelNO = 0
cmdDel.Enabled = False
Else
cmdDel.Enabled = True '删除有效
EF.MoveFirst
Do While Not EF.EOF
DelNO = DelNO + 1
EF.MoveNext
Loop
End If
Grid2.Rows = DelNO + 2
If Grid2.Rows < 21 Then
Grid2.Rows = 21
End If
If DelNO > 0 Then
EF.MoveFirst '返回第一
HH = 1
Do While Not EF.EOF()
Grid2.Row = HH
Grid2.Col = 0
Grid2.CellAlignment = 4
If Not IsNull(EF.Fields(0).Value) Then
Grid2.Text = EF.Fields(0).Value
End If
Grid2.Row = HH
Grid2.Col = 1
Grid2.CellAlignment = 1
If Not IsNull(EF.Fields(4).Value) Then
Grid2.Text = EF.Fields(4).Value
End If
Grid2.Row = HH
Grid2.Col = 2
Grid2.CellAlignment = 1
If Not IsNull(EF.Fields(5).Value) Then
Grid2.Text = EF.Fields(5).Value
End If
Grid2.Row = HH
Grid2.Col = 3
Grid2.CellAlignment = 1
If Not IsNull(EF.Fields(6).Value) Then
Grid2.Text = EF.Fields(6).Value
End If
Grid2.Row = HH
Grid2.Col = 4
Grid2.CellAlignment = 1
If Not IsNull(EF.Fields(7).Value) Then
Grid2.Text = EF.Fields(7).Value
End If
Grid2.Row = HH
Grid2.Col = 5
Grid2.CellAlignment = 1
If Not IsNull(EF.Fields(8).Value) Then
Grid2.Text = EF.Fields(8).Value
End If
Grid2.Row = HH
Grid2.Col = 6
Grid2.CellAlignment = 1
If Not IsNull(EF.Fields(12).Value) Then
Grid2.Text = EF.Fields(12).Value
End If
EF.MoveNext
HH = HH + 1
Loop
EF.Close
DB.Close
'合计:
Grid2.Col = 5
Dim lAmount As Currency
Dim X As Integer
For X = 1 To Grid2.Rows - 2
Grid2.Row = X
lAmount = lAmount + Val(Grid2.Text)
Next
cJE = lAmount '金额合计
Grid2.Row = Grid2.Rows - 1
Grid2.Col = 1
Grid2.CellAlignment = 1
Grid2.CellForeColor = RGB(255, 0, 0)
Grid2.Text = "***** 合计 ****"
Grid2.Col = 5
Grid2.CellAlignment = 1
Grid2.CellForeColor = RGB(255, 0, 0)
Grid2.Text = Format(lAmount, "Currency")
End If
Grid2.Col = 1
Grid2.Row = 1
Grid2.ColSel = 6
Grid2.Visible = True
Exit Sub
Err_init:
MsgBox "网络配置错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub cmbCode_Change()
If Trim(cmbCode.Text) <> "" And Trim(cmbSite.Text) <> "" And Val(txtSL) > 0 Then
cmdAdd.Enabled = True
Else
cmdAdd.Enabled = False
End If
If bDel = True Then Exit Sub
Dim iStart As Integer
Dim sString As String
Static iLeftOff1 As Integer
iStart = 1
iStart = cmbCode.SelStart
If iLeftOff1 <> 0 Then
cmbCode.SelStart = iLeftOff1
iStart = iLeftOff1
End If
sString = CStr(Left(cmbCode.Text, iStart))
cmbCode.ListIndex = SendMessage(cmbCode.hwnd, CB_FINDSTRING, -1, ByVal CStr(Left(cmbCode.Text, iStart)))
If cmbCode.ListIndex = -1 Then
iLeftOff1 = Len(sString)
cmbCode.Text = sString
cmbCode.SelStart = iStart
End If
cmbCode.SelStart = iStart
If Len(cmbCode) > 1 Then
cmbCode.SelLength = Len(cmbCode) - iStart
Else
cmbCode.SelLength = 0
End If
iLeftOff1 = 0
End Sub
Private Sub cmbCode_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 8 Then '退格键
KeyCode = 0
bDel = True
Exit Sub
End If
If KeyCode = 46 Then '删除
bDel = True
cmbCode.SelText = ""
Exit Sub
End If
bDel = False
End Sub
Private Sub cmbCode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtSL.SetFocus
Exit Sub
End If
End Sub
Private Sub txtSL_KeyDown(KeyCode As Integer, Shift As Integer)
DirectFocus cmbCode, cmdAdd, txtSL, txtSL, KeyCode
End Sub
Private Sub txtSl_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 GetRecord(sWP As String, sFields As String, sTable As String)
On Error GoTo Err_init
Dim DB As Database
Dim EF As Recordset
Dim sEXE As String
Set DB = OpenDatabase(ConData, False, False, Constr)
' SQL语言删除
sEXE = "Select * From " & sTable & " Where " & sFields & "='" & sWP & "'"
Set EF = DB.OpenRecordset(sEXE, dbOpenDynaset)
If EF.EOF And EF.BOF Then
lDJ = 0: sName = "": sDJ = "": sDW = "": sType = ""
Else
lDJ = EF.Fields("单价").Value
sName = EF.Fields("名称").Value
sDW = EF.Fields("单位").Value
sCode = sWP
sType = EF.Fields("MenuType")
End If
EF.Close
DB.Close
Exit Sub
Err_init:
MsgBox "添加记录错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -