?? 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 + -