📄 frmpreview.frm
字号:
Exit Sub
Err_DC:
curConsumeAmo = 0
Me.MousePointer = 0
MsgBox "合计消费金额错误： " & vbCrLf & vbCrLf & Err.Description, vbInformation
Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
SaveFormSet Me
End Sub
Private Sub HScroll1_Change()
DisplayPicture.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Change()
On Error Resume Next
DisplayPicture.Top = -VScroll1.Value
End Sub
Private Sub ResizePic()
On Error Resume Next
Select Case cmbSize.Text
Case "页宽"
DisplayPicture.Stretch = True '自动变焦为真
Dim lWidth As Long
lWidth = picPrint.Width
DisplayPicture.Width = Picture1.Width
DisplayPicture.Height = picPrint.Width - (lWidth - Picture1.Width)
HScroll1.Visible = False
If DisplayPicture.Height > Picture1.Height Then
VScroll1.Value = 0
VScroll1.Max = DisplayPicture.Height - Picture1.Height
VScroll1.Visible = True
End If
Case "整页"
DisplayPicture.Stretch = True
lWidth = picPrint.Height
DisplayPicture.Height = Picture1.Height
DisplayPicture.Width = picPrint.Height - (lWidth - Picture1.Height)
HScroll1.Visible = False
VScroll1.Visible = False
Command3.Visible = False
Case "100%"
DisplayPicture.Stretch = False
HScroll1.Value = 0
VScroll1.Value = 0
HScroll1.Max = picPrint.Width - Picture1.Width + 280
VScroll1.Max = picPrint.Height - Picture1.Height + 280
VScroll1.Visible = True
HScroll1.Visible = True
Command3.Visible = True
End Select
End Sub
Private Function GetSiteID(stmpIds As String) As String
On Error GoTo GetERR
Dim pDB As Connection
Dim pRS As Recordset
Dim sTmpx As String
Set pDB = CreateObject("ADODB.Connection")
Set pRS = CreateObject("ADODB.Recordset")
pDB.Open Constr
sTmpx = "SElect * from tmpSite Where Site='" & stmpIds & "'"
pRS.Open sTmpx, pDB, adOpenStatic, adLockReadOnly, adCmdText
If pRS.EOF And pRS.BOF Then
GetSiteID = ""
Else
GetSiteID = pRS("ID")
End If
pRS.Close
pDB.Close
Set pRS = Nothing
Set pDB = Nothing
Exit Function
GetERR:
GetSiteID = ""
MsgBox "对不起,给出消费单号错误:" & Err.Description, vbCritical
Exit Function
End Function
Private Sub PrintPreview(nID As String)
On Error GoTo PrintErr
If nID = "" Then
MsgBox "消费单为空，不能预览？ ", vbInformation
Exit Sub
End If
'打印格式
Dim bExit As Boolean
Dim sWaiter As String
Dim DB As Connection, EF As Recordset
Dim sBB As String
Set DB = CreateObject("ADODB.Connection")
DB.Open Constr
sBB = "Delete From prtCust"
DB.Execute sBB
' sBB = "INSERT Into prtCust SELECT DType AS DType, Name AS Name, Unit AS Unit, Price AS Price, Sum(Quanty) AS Quantys, Sum(JGF) AS JGFs, Sum(Amos) AS Amoss From tmpCust WHERE Site='" & sPubSite & "' GROUP BY DType, Name, Unit, Price"
' DB.Execute sBB
Set EF = CreateObject("ADODB.Recordset")
EF.Open "SELECT DType AS DType, Name AS Name, Unit AS Unit, Price AS Price, Sum(Quanty) AS Quantys, Sum(JGF) AS JGFs, Sum(Amos) AS Amoss From tmpCust WHERE Site='" & sPubSite & "' GROUP BY DType, Name, Unit, Price", DB, adOpenStatic, adLockReadOnly, adCmdText
' EF.Open "Select * From prtCust", DB, adOpenStatic, adLockReadOnly, adCmdText
Dim lPaperCountS As Integer, lPaperCount As Integer
Dim lCurrent As Integer
If EF.BOF And EF.EOF Then '没有记录时 退出
EF.Close
Set EF = Nothing
DB.Close
Set DB = Nothing
MsgBox "没有消费记录,不能预览。 ", vbExclamation
Exit Sub
Else
lPaperCount = 0
Do While Not EF.EOF
lPaperCount = lPaperCount + 1
EF.MoveNext
Loop
EF.MoveFirst
End If
'计算总页数
lPaperCountS = lPaperCount / 24
If (lPaperCount Mod 24) <> 0 And (lPaperCount > 24) Then '正除时不加0
lPaperCountS = lPaperCountS + 1
End If
If lPaperCountS = 0 Then
lPaperCountS = lPaperCountS + 1
End If
'给出所有页=============================================================
curPages = lPaperCountS
'显示共有几页
txtNumber.Text = lPaperCountS
'如果大于总页时,给出最新一页
If curPage > curPages Then
curPage = curPages
End If
'小于0时，显示第一页
If curPage <= 0 Then
curPage = 1
End If
txtCurPage.Text = curPage
'使下一页与上一页按钮作用
If curPages = 1 Then
cmdUp.Enabled = False: cmdDown.Enabled = False
Else
If curPage = 1 Then
cmdUp.Enabled = False
cmdDown.Enabled = True
ElseIf curPage = curPages Then
cmdDown.Enabled = False
cmdUp.Enabled = True
Else
cmdUp.Enabled = True
cmdDown.Enabled = True
End If
End If
'=======================================================================
Dim x As Integer
Dim sPN As String
Dim cDJ As String
Dim lSL As String
Dim cJE As String
Dim cDW As String
Dim H As Integer
Dim cJGF As String
Dim sType As String '类型
Dim sType1 As String '类型
'开始打印
picPrint.ScaleMode = 6 'mm
For x = 1 To lPaperCountS
'仅显示当前页
If curPage = x Then
'打印单位名称
picPrint.FontSize = 24
picPrint.FontName = "黑体"
picPrint.FontBold = True
picPrint.CurrentX = ((110 - (picPrint.TextWidth(sUnit))) / 2) + 8
picPrint.CurrentY = XTop + 8
'NoTitle为不打印标题，客户可自行给出
'NoTitle=1 Or -1
If NoTitle = False Then
picPrint.Print sUnit
End If
picPrint.FontSize = 9
picPrint.FontName = "黑体"
picPrint.FontBold = True
picPrint.CurrentX = 8 + XLeft
picPrint.CurrentY = 26 + XTop
picPrint.Print "单号:" & nID
If frmCash.chkArrearage.Value = vbChecked Then
'打印挂帐
picPrint.CurrentX = 42 + XLeft
picPrint.CurrentY = 26 + XTop
picPrint.Print "挂帐"
Else
picPrint.CurrentX = 42 + XLeft
picPrint.CurrentY = 26 + XTop
picPrint.Print "结帐:" & frmCash.cmbPayMethod.Text
End If
picPrint.CurrentX = 75 + XLeft
picPrint.CurrentY = 26 + XTop
picPrint.Print "日期:" & Format(Date, "Long Date")
'桌号
picPrint.CurrentX = 8 + XLeft
picPrint.CurrentY = 32 + XTop
picPrint.Print "桌号:" & sPubSite
'会员信息
If Trim(frmCash.ftCID.Text) <> "" And Trim(frmCash.ftCName.Text) <> "" Then
picPrint.CurrentX = 42 + XLeft
picPrint.CurrentY = 32 + XTop
picPrint.Print "会员:" & frmCash.ftCID.Text
picPrint.CurrentX = 75 + XLeft
picPrint.CurrentY = 32 + XTop
picPrint.Print "姓名:" & frmCash.ftCName.Text
End If
'打印菜单标题
picPrint.CurrentX = 8 + XLeft
picPrint.CurrentY = 40 + XTop
picPrint.FontBold = False
picPrint.Font = "宋体"
picPrint.Print "菜单类别 "
picPrint.CurrentX = 29 + XLeft
picPrint.CurrentY = 40 + XTop
picPrint.Print "菜 名 "
picPrint.CurrentY = 40 + XTop
picPrint.CurrentX = 65 + XLeft
picPrint.Print "单位"
picPrint.CurrentY = 40 + XTop
picPrint.CurrentX = 75 + XLeft
picPrint.Print "单价"
picPrint.CurrentY = 40 + XTop
picPrint.CurrentX = 83 + XLeft
picPrint.Print "数量"
picPrint.CurrentY = 40 + XTop
picPrint.CurrentX = 89 + XLeft
picPrint.Print "加工"
picPrint.CurrentY = 40 + XTop
picPrint.CurrentX = 98 + XLeft
picPrint.Print "金额"
'-----------------------------------------
H = 1
If x = 1 Then '分页
EF.MoveFirst
Else
EF.MoveFirst
EF.Move ((x - 1) * 24)
End If
'打印所有菜单
Do While Not EF.EOF
sPN = "": cDW = "": cDJ = 0: lSL = 0: cJE = 0: sType = "": cJGF = "" '清空
If EF.EOF Then
bExit = True
Exit For '退出
End If
If H > 24 Then
Exit Do
End If
If Not IsNull(EF.Fields("DType")) Then '不为空时
sType = EF.Fields("DType")
End If
If Not IsNull(EF.Fields("Name")) Then '不为空时
sPN = EF.Fields("Name")
End If
If Not IsNull(EF.Fields("Price")) Then '不为空时
cDJ = Trim(str(EF.Fields("Price")))
End If
If Not IsNull(EF.Fields("Quantys")) Then '不为空时
lSL = Trim(str(EF.Fields("Quantys")))
End If
If Not IsNull(EF.Fields("Unit")) Then '不为空时
cDW = EF.Fields("Unit")
End If
If Not IsNull(EF.Fields("JGFs")) Then '不为空时
cJGF = Trim(str(EF.Fields("JGFs")))
End If
If Not IsNull(EF.Fields("Amoss")) Then '不为空时
cJE = Trim(str(EF.Fields("Amoss")))
End If
picPrint.Font = "宋体"
picPrint.FontSize = 9
picPrint.FontBold = False
If sType <> sType1 Then
sType1 = sType
picPrint.CurrentX = 6 + XLeft
picPrint.CurrentY = 43 + (H * 6) + XTop
picPrint.Print " " & sType
End If
picPrint.CurrentX = 27 + XLeft
picPrint.CurrentY = 43 + (H * 6) + XTop
picPrint.Print " " & sPN
picPrint.CurrentY = 43 + (H * 6) + XTop
picPrint.CurrentX = 65 + XLeft
picPrint.Print cDW
picPrint.CurrentY = 43 + (H * 6) + XTop
picPrint.CurrentX = 75 + XLeft
picPrint.Print cDJ
picPrint.CurrentY = 43 + (H * 6) + XTop
picPrint.CurrentX = 83 + XLeft
picPrint.Print lSL
picPrint.CurrentY = 43 + (H * 6) + XTop
picPrint.CurrentX = 89 + XLeft
picPrint.Print cJGF
picPrint.CurrentY = 43 + (H * 6) + XTop
picPrint.CurrentX = 98 + XLeft
picPrint.Print cJE
H = H + 1
EF.MoveNext
Loop
End If
'最后一页打印合计
If x = lPaperCountS Then '最后一页
picPrint.FontSize = 9
picPrint.FontName = "黑体"
picPrint.FontBold = True
picPrint.CurrentY = 43 + ((H + 1) * 6) + XTop '200 + xtop
picPrint.CurrentX = 8 + XLeft
picPrint.Print " 消费金额:" & CStr(curConsumeAmo) & "元"
picPrint.CurrentY = 43 + ((H + 1) * 6) + XTop '200 + xtop
picPrint.CurrentX = 45 + XLeft
picPrint.Print "包厢费:" & frmCash.txtBXF.Text & "元"
picPrint.CurrentY = 43 + ((H + 1) * 6) + XTop
picPrint.CurrentX = 70 + XLeft
picPrint.Print "金额合计:" & frmCash.txtJE.Text & "元"
If frmCash.cmbDZ.Text <> "100" Then
picPrint.CurrentY = 43 + ((H + 2) * 6) + XTop
picPrint.CurrentX = 45 + XLeft
picPrint.Print frmCash.cmbDZ.Text & "%折"
End If
picPrint.CurrentY = 43 + ((H + 2) * 6) + XTop '200 + xtop
picPrint.CurrentX = 70 + XLeft
picPrint.Print "应付金额:" & frmCash.txtFK.Text & "元"
picPrint.CurrentY = 43 + ((H + 3) * 6) + XTop '200 + xtop
picPrint.CurrentX = 8 + XLeft
picPrint.Print " 实收现金:" & frmCash.txtSK.Text & "元"
picPrint.CurrentY = 43 + ((H + 3) * 6) + XTop '200 + xtop
picPrint.CurrentX = 45 + XLeft
picPrint.Print "找零:" & frmCash.txtZL.Text & "元"
picPrint.CurrentY = 43 + ((H + 3) * 6) + XTop '200 + xtop
picPrint.CurrentX = 70 + XLeft
picPrint.Print " 操作员:" & UserText
End If
If bExit = True Then '无记录时退出
Exit For
End If
Next
EF.Close
DB.Close
Set EF = Nothing
Set DB = Nothing
'将预览内容放置Image中
DisplayPicture.Picture = picPrint.Image
Exit Sub
PrintErr:
MsgBox "对不起,预览错误:" & Err.Description & vbCrLf _
& "请设置打印纸的大小为：长 21 厘米宽 11 厘米。 ", vbCritical
End Sub
Private Function GetCustomerRate(stmpID As String) As Currency
On Error GoTo CustomerERR
Dim TmpDB As Connection
Dim tmpRs As Recordset
Dim sNews As String
Set TmpDB = CreateObject("ADODB.Connection")
Set tmpRs = CreateObject("ADODB.Recordset")
TmpDB.Open Constr
sNews = "Select tbdMember.DLevel,tbdLevel.DDiscount " _
& " from tbdMember Inner Join tbdLevel On tbdMember.Dlevel=tbdLevel.ID " _
& " Where tbdMember.ID='" & stmpID & "'"
tmpRs.Open sNews, TmpDB, adOpenStatic, adLockReadOnly, adCmdText
If Not (tmpRs.EOF And tmpRs.BOF) Then
GetCustomerRate = tmpRs("DDiscount")
Else
GetCustomerRate = 100
End If
tmpRs.Close
TmpDB.Close
Set tmpRs = Nothing
Set TmpDB = Nothing
Exit Function
CustomerERR:
MsgBox "对不起,给出会员的打折情况错误：" & Err.Description, vbCritical
GetCustomerRate = 100
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -