?? 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 = "今日消費(fèi)與統(tǒng)計(jì)"
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 = "關(guān)閉(&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 = "今日消費(fèi)"
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 = "消費(fèi)日期:"
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 = "項(xiàng)目名稱"
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 = "上臺筆數(shù)"
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("真的要打印【消費(fèi)總表】嗎？(Y/N) " & vbCrLf _
& "請?jiān)O(shè)置打印機(jī)的紙張：A4 縱向 " & vbCrLf & vbCrLf _
& "如果只打印今日總表,請按【今日消費(fèi)】按鈕后再打印。 ", vbInformation + vbYesNo, "網(wǎng)維軟件") = 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 = "【消費(fèi)總表】"
ptGrid.N_Head10 = "消費(fèi)開始日期：" & dtpStart.Value & " 至 " & dtpEnd.Value
ptGrid.N_Head11 = " 制表人：" & UserText
ptGrid.N_Head2 = "制表時(shí)間：" & 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 "對不起,打印列表錯(cuò)誤。 " & vbCrLf & vbCrLf & Err.Description, vbInformation
Exit Sub
End Sub
Private Sub cmdSearch_Click()
'顯示今日消費(fèi)數(shù)據(jù)
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()
'顯示今日消費(fèi)數(shù)據(jù)
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 "結(jié)束日期小于開始日期,系統(tǒng)將自動修改開始日期。 ", vbExclamation
dtpStart.Value = dtpEnd.Value
Exit Sub
End If
End Sub
Private Sub dtpStart_Change()
If dtpEnd.Value < dtpStart.Value Then
MsgBox "結(jié)束日期小于開始日期,系統(tǒng)將自動修改結(jié)束日期。 ", vbExclamation
dtpEnd.Value = dtpStart.Value
Exit Sub
End If
End Sub
Private Sub Form_Load()
frmMain.lbControl = "今日消費(fèi)與統(tǒng)計(jì)"
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
'顯示消費(fèi)數(shù)據(jù)
DisplayCashData
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState = 1 Then Exit Sub
'常規(guī)時(shí)
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")
'如果為掛帳時(shí)，不統(tǒng)計(jì)現(xiàn)金，只顯示掛帳金額
Select Case EF("DType")
Case "掛帳"
curArrearage = curArrearage + EF("DCash")
Case "掛帳結(jié)帳"
curGive = curGive + EF("DCash")
End Select
'掛帳項(xiàng)目不納入。
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
'添加合計(jì)數(shù)據(jù)
'InsertToCashList lstPro, "", "【 欠 款 】", CStr(curArrearage) & "元", Chr(10)
'InsertToCashList lstPro, "", "【 還 款 】", CStr(curGive) & "元", Chr(10)
InsertToCashList lstPro, "", "【 合 計(jì) 】", CStr(curCash) & "元", CStr(curNumber) & "桌"
lstPro.Visible = True
Me.MousePointer = 0
Exit Sub
Err_init:
Me.MousePointer = 0
MsgBox "顯示消費(fèi)數(shù)據(jù)錯(cuò)誤! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -