📄 frmshowcard.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 frmShowCard
BorderStyle = 3 'Fixed Dialog
Caption = "会员卡消费对帐单"
ClientHeight = 6840
ClientLeft = 45
ClientTop = 330
ClientWidth = 10485
Icon = "frmShowCard.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6840
ScaleWidth = 10485
ShowInTaskbar = 0 'False
Begin VB.Frame Frame1
Height = 735
Left = 90
TabIndex = 6
Top = 30
Width = 10305
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 = 5880
TabIndex = 3
Top = 195
Width = 1425
End
Begin MSComCtl2.DTPicker dtpStart
Height = 315
Left = 1170
TabIndex = 0
Top = 255
Width = 1485
_ExtentX = 2619
_ExtentY = 556
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 60096513
CurrentDate = 37603
End
Begin VB.CommandButton cmdFind
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 = 4470
TabIndex = 2
Top = 195
Width = 1425
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 = 8895
TabIndex = 4
Top = 195
Width = 1275
End
Begin MSComCtl2.DTPicker dtpEnd
Height = 315
Left = 2895
TabIndex = 1
Top = 255
Width = 1485
_ExtentX = 2619
_ExtentY = 556
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 60096513
CurrentDate = 37603
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "至"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 2670
TabIndex = 8
Top = 300
Width = 210
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "消费日期:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 180
TabIndex = 7
Top = 300
Width = 945
End
End
Begin MSComctlLib.ListView lstPro
Height = 5985
Left = 75
TabIndex = 5
Top = 780
Width = 10335
_ExtentX = 18230
_ExtentY = 10557
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 = 9
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "会员名称"
Object.Width = 1940
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 1
Text = "消费日期"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 2
Text = "时"
Object.Width = 706
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "分"
Object.Width = 706
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "描述"
Object.Width = 4939
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 5
Text = "消费金额"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 6
Text = "充值金额"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 7
Text = "卡内余额"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 8
Text = "操作员"
Object.Width = 1764
EndProperty
End
End
Attribute VB_Name = "frmShowCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public stmpMember As String '公共的会员名
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdFind_Click()
'查询对帐单
If IsSqlDat = True Then
sFindString = " Where tbdMemberDetail.Date>='" & dtpStart.Value & "' And tbdMemberDetail.Date<='" & dtpEnd.Value & "' And tbdMemberDetail.MID='" & stmpMember & "' Order By tbdMemberDetail.myID"
Else
sFindString = " Where tbdMemberDetail.Date>=#" & dtpStart.Value & "# And tbdMemberDetail.Date<=#" & dtpEnd.Value & "# And tbdMemberDetail.MID='" & stmpMember & "' Order By tbdMemberDetail.myID"
End If
LoadData
End Sub
Private Sub cmdPrint_Click()
If lstPro.ListItems.Count = 0 Then Exit Sub
'打印列表
If MsgBox("真的要打印【会员卡消费列表】吗？(Y/N) " & vbCrLf _
& "请设置打印机的纸张：A4 纵向 " & vbCrLf & vbCrLf _
& "如果需要打印部份,请首先查询后再打印。 ", vbInformation + vbYesNo, "www.vb-code.net") = 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,5,6,7,8,9"
Set ptGrid.N_Grid = lstPro
ptGrid.N_TiTle = "【会员卡消费列表】"
ptGrid.N_Head10 = "消费日期：" & dtpStart.Value & "至" & dtpEnd.Value
ptGrid.N_Head2 = "制表时间：" & Now & " 制表人：" & UserText
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 dtpEnd_Change()
On Error Resume Next
If dtpStart.Value > dtpEnd.Value Then
dtpStart.Value = dtpEnd.Value
End If
End Sub
Private Sub dtpStart_Change()
On Error Resume Next
If dtpStart.Value > dtpEnd.Value Then
dtpEnd.Value = dtpStart.Value
End If
End Sub
Private Sub Form_Load()
GetFormSet Me, Screen
sFindString = ""
'缺省显示一个月的对帐单
dtpStart.Value = Date - 30
dtpEnd.Value = Date
If IsSqlDat = True Then
sFindString = " Where tbdMemberDetail.Date>='" & dtpStart.Value & "' And tbdMemberDetail.Date<='" & dtpEnd.Value & "' And tbdMemberDetail.MID='" & stmpMember & "' Order By tbdMemberDetail.myID"
Else
sFindString = " Where tbdMemberDetail.Date>=#" & dtpStart.Value & "# And tbdMemberDetail.Date<=#" & dtpEnd.Value & "# And tbdMemberDetail.MID='" & stmpMember & "' Order By tbdMemberDetail.myID"
End If
LoadData
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
SaveFormSet Me
sFindString = ""
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
Public Sub LoadData()
On Error GoTo Err_init
Me.MousePointer = 11
Dim DB As Connection, EF As Recordset
Set DB = CreateObject("ADODB.Connection")
Set EF = CreateObject("ADODB.Recordset")
DB.Open Constr
EF.Open "Select tbdmemberdetail.*,tbdMember.Name from tbdmemberdetail Inner Join tbdMember On tbdmemberdetail.MID=tbdmember.ID " & sFindString, DB, adOpenStatic, adLockReadOnly, adCmdText
lstPro.Visible = False
lstPro.ListItems.Clear
If Not (EF.EOF And EF.BOF) Then
Do While Not EF.EOF
InsertToMember lstPro, EF("Name"), EF("Date"), EF("lHour"), EF("lMinute"), EF("Remark"), EF("Amo"), EF("GetAmo"), EF("Remain"), NullValue(EF("Oper"))
EF.MoveNext
DoEvents
Loop
End If
EF.Close
DB.Close
Set EF = Nothing
Set DB = Nothing
lstPro.Visible = True
Me.MousePointer = 0
Exit Sub
Err_init:
Me.MousePointer = 0
MsgBox "网络配置错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub InsertToMember(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
, sText4 As String, sText5 As String, sText6 As String, sText7 As String, sText8 As String, sText9 As String)
On Error Resume Next
If Trim(sText1) = "" Then Exit Sub
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)
lstTmp.SubItems(4) = Trim(sText5)
lstTmp.SubItems(5) = Format(sText6, "0.00")
lstTmp.SubItems(6) = Format(sText7, "0.00")
lstTmp.SubItems(7) = Format(sText8, "0.00")
lstTmp.SubItems(8) = Trim(sText9)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -