📄 frmtodayconsume.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmTodayConsume
Caption = "今日消费与统计"
ClientHeight = 5175
ClientLeft = 60
ClientTop = 345
ClientWidth = 7665
Icon = "frmTodayConsume.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 5175
ScaleWidth = 7665
WindowState = 2 'Maximized
Begin VB.Frame Frame1
Height = 780
Left = 120
TabIndex = 7
Top = -15
Width = 9495
Begin MSComCtl2.DTPicker dtpStart
Height = 315
Left = 1290
TabIndex = 0
Top = 285
Width = 1350
_ExtentX = 2381
_ExtentY = 556
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 25821185
CurrentDate = 37507
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "关闭(&C)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 8235
TabIndex = 5
Top = 225
Width = 1275
End
Begin VB.CommandButton cmdPrint
Caption = "打印(&P)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 6870
TabIndex = 4
Top = 225
Width = 1275
End
Begin VB.CommandButton cmdToday
Caption = "今日消费"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5610
TabIndex = 3
Top = 225
Width = 1275
End
Begin VB.CommandButton cmdSearch
Caption = "查询(&F)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 4350
TabIndex = 2
Top = 225
Width = 1275
End
Begin MSComCtl2.DTPicker dtpEnd
Height = 315
Left = 2940
TabIndex = 1
Top = 285
Width = 1350
_ExtentX = 2381
_ExtentY = 556
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 25821185
CurrentDate = 37507
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "至"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Index = 1
Left = 2685
TabIndex = 9
Top = 285
Width = 240
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "消费日期:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Index = 0
Left = 225
TabIndex = 8
Top = 285
Width = 1020
End
End
Begin MSComctlLib.ListView lstPro
Height = 3675
Left = 120
TabIndex = 6
Top = 810
Width = 6075
_ExtentX = 10716
_ExtentY = 6482
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
AllowReorder = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "日 期"
Object.Width = 2469
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "项目名称"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 2
Text = "金 额"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 3
Text = "上台笔数"
Object.Width = 2540
EndProperty
End
End
Attribute VB_Name = "frmTodayConsume"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdPrint_Click()
If lstPro.ListItems.Count = 0 Then Exit Sub
'打印列表
If MsgBox("真的要打印【消费总表】吗？(Y/N) " & vbCrLf _
& "请设置打印机的纸张：A4 纵向 " & vbCrLf & vbCrLf _
& "如果只打印今日总表,请按【今日消费】按钮后再打印。 ", vbInformation + vbYesNo, "网维软件") = vbNo Then
Exit Sub
End If
Dim ptGrid As listViewPrint
'建立打印对象
On Error GoTo Err1
Dim strPageLeft As String
Dim strPageTop As String
Dim PageTop As Long
Dim PageLeft As Long
Set ptGrid = New listViewPrint
ptGrid.N_Border = 1
ptGrid.N_Cols = "1,2,3,4"
Set ptGrid.N_Grid = lstPro
ptGrid.N_TiTle = "【消费总表】"
ptGrid.N_Head10 = "消费开始日期：" & dtpStart.Value & " 至 " & dtpEnd.Value
ptGrid.N_Head11 = " 制表人：" & UserText
ptGrid.N_Head2 = "制表时间：" & Now
ptGrid.N_PageLeft = XLeft
ptGrid.N_PageTop = XTop
ptGrid.N_PageHeight = 290
ptGrid.N_PageWidth = 200
ptGrid.N_RowHeight = 6
ptGrid.PrintPage
Set ptGrid = Nothing
Exit Sub
Err1:
MsgBox "对不起,打印列表错误。 " & vbCrLf & vbCrLf & Err.Description, vbInformation
Exit Sub
End Sub
Private Sub cmdSearch_Click()
'显示今日消费数据
If IsSqlDat = True Then
sFindString = " Where DDate>='" & dtpStart.Value & "' And DDate<='" & dtpEnd.Value & "'"
Else
sFindString = " Where DDate>=#" & dtpStart.Value & "# And DDate<=#" & dtpEnd.Value & "#"
End If
DisplayCashData
End Sub
Private Sub cmdToday_Click()
'显示今日消费数据
dtpStart.Value = Date: dtpEnd.Value = Date
If IsSqlDat = True Then
sFindString = " Where DDate='" & Date & "'"
Else
sFindString = " Where DDate=#" & Date & "#"
End If
DisplayCashData
End Sub
Private Sub dtpEnd_Change()
If dtpEnd.Value < dtpStart.Value Then
MsgBox "结束日期小于开始日期,系统将自动修改开始日期。 ", vbExclamation
dtpStart.Value = dtpEnd.Value
Exit Sub
End If
End Sub
Private Sub dtpStart_Change()
If dtpEnd.Value < dtpStart.Value Then
MsgBox "结束日期小于开始日期,系统将自动修改结束日期。 ", vbExclamation
dtpEnd.Value = dtpStart.Value
Exit Sub
End If
End Sub
Private Sub Form_Load()
frmMain.lbControl = "今日消费与统计"
TodayCashFocus = True
GetFormSet Me, frmMain
dtpStart.Value = Date
dtpEnd.Value = Date
If IsSqlDat = True Then
sFindString = " Where DDate>='" & dtpStart.Value & "' And DDate<='" & dtpEnd.Value & "'"
Else
sFindString = " Where DDate>=#" & dtpStart.Value & "# And DDate<=#" & dtpEnd.Value & "#"
End If
'显示消费数据
DisplayCashData
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState = 1 Then Exit Sub
'常规时
If Me.WindowState = 0 Then
Me.Move 1, 1, frmMain.Width - (frmMain.picTool.Width + 200), frmMain.Height - (frmMain.picADV.Height + 1150)
End If
'浏览带
lstPro.Left = 100
lstPro.Width = Me.Width - 300
lstPro.Height = Me.Height - Frame1.Height - 550
Frame1.Width = Me.Width - 330
cmdCancel.Left = Me.Width - cmdCancel.Width - 500
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmMain.lbControl = "收银控制中心"
TodayCashFocus = False
SaveFormSet Me
End Sub
Private Sub lstPro_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
On Error Resume Next
'排序操作
If lstPro.ListItems.Count > 0 Then
lstPro.SortKey = ColumnHeader.Index - 1
lstPro.Sorted = True
If lstPro.SortOrder = lvwAscending Then
lstPro.SortOrder = lvwDescending
Else
lstPro.SortOrder = lvwAscending
End If
End If
End Sub
Private Sub InsertToCashList(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
, sText4 As String)
On Error Resume Next
Dim lstTmp As ListItem
Set lstTmp = tmpView.ListItems.Add
lstTmp.Text = Trim(sText1)
lstTmp.SubItems(1) = Trim(sText2)
lstTmp.SubItems(2) = Trim(sText3)
lstTmp.SubItems(3) = Trim(sText4)
End Sub
Private Sub DisplayCashData()
On Error GoTo Err_init
Me.MousePointer = 11
Dim curCash As Currency, curNumber As Long
Dim curArrearage As Currency, curGive As Currency
curCash = 0: curNumber = 0: curArrearage = 0: curGive = 0
Dim DB As Connection, EF As Recordset
Set DB = CreateObject("ADODB.Connection")
Set EF = CreateObject("ADODB.Recordset")
DB.Open Constr
'按日期倒序
EF.Open "Select * from tbdCash" & sFindString & " Order By Ddate Desc", DB, adOpenStatic, adLockReadOnly, adCmdText
lstPro.Visible = False
lstPro.ListItems.Clear
If Not (EF.EOF And EF.BOF) Then
Do While Not EF.EOF
InsertToCashList lstPro, EF("DDate"), EF("DType"), EF("DCash"), EF("DNumber")
'如果为挂帐时，不统计现金，只显示挂帐金额
Select Case EF("DType")
Case "挂帐"
curArrearage = curArrearage + EF("DCash")
Case "挂帐结帐"
curGive = curGive + EF("DCash")
End Select
'挂帐项目不纳入。
If EF("DType") <> "挂帐" Then
curCash = curCash + EF("DCash")
curNumber = curNumber + EF("DNumber")
End If
EF.MoveNext
DoEvents
Loop
End If
EF.Close
DB.Close
Set EF = Nothing
Set DB = Nothing
'添加合计数据
'InsertToCashList lstPro, "", "【 欠 款 】", CStr(curArrearage) & "元", Chr(10)
'InsertToCashList lstPro, "", "【 还 款 】", CStr(curGive) & "元", Chr(10)
InsertToCashList lstPro, "", "【 合 计 】", CStr(curCash) & "元", CStr(curNumber) & "桌"
lstPro.Visible = True
Me.MousePointer = 0
Exit Sub
Err_init:
Me.MousePointer = 0
MsgBox "显示消费数据错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -