📄 frmallmanage.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{57EA6131-FAB3-49C3-BF10-85A4777A5A7C}#1.0#0"; "XPButton.ocx"
Begin VB.Form FrmAllManage
Caption = "综合管理"
ClientHeight = 7350
ClientLeft = 60
ClientTop = 450
ClientWidth = 10290
Icon = "FrmAllManage.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7350
ScaleWidth = 10290
StartUpPosition = 1 '所有者中心
Begin MSComctlLib.ListView LvwAll
Height = 5655
Left = 120
TabIndex = 1
Top = 1080
Width = 9990
_ExtentX = 17621
_ExtentY = 9975
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Frame FraQry
Height = 855
Left = 120
TabIndex = 0
Top = 120
Width = 9990
Begin VB.OptionButton OptInUsed
Caption = "过期的"
Height = 255
Index = 1
Left = 3360
TabIndex = 3
Top = 360
Width = 975
End
Begin VB.OptionButton OptInUsed
Caption = "使用中的"
Height = 255
Index = 0
Left = 2040
TabIndex = 2
Top = 360
Value = -1 'True
Width = 1215
End
Begin VB.Label LblInUsed
AutoSize = -1 'True
Caption = "会员卡使用情况:"
Height = 180
Left = 240
TabIndex = 4
Top = 360
Width = 1350
End
End
Begin XP_Button.XPButton BtnBack
Height = 330
Left = 9135
TabIndex = 5
Top = 6885
Width = 1005
_ExtentX = 1773
_ExtentY = 582
caption = "返回"
End
Begin VB.Menu MnuLvw
Caption = "MnuLvw"
Visible = 0 'False
Begin VB.Menu mnuSee
Caption = "查看"
End
Begin VB.Menu mnuModify
Caption = "修改"
End
Begin VB.Menu mnuDel
Caption = "删除"
End
End
End
Attribute VB_Name = "FrmAllManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub btnBack_Click()
Unload Me '退出
End Sub
'overdue过期的
Private Sub Form_Load()
Call MdlDB.DataIni
With Me.LvwAll
.ColumnHeaders.Add , , "身份证号", 1800
.ColumnHeaders.Add , , "姓名", 1600, 2
.ColumnHeaders.Add , , "会员卡号", 1200, 2
.ColumnHeaders.Add , , "起始日期", 1500, 2
.ColumnHeaders.Add , , "截止日期", 1500, 2
.ColumnHeaders.Add , , "使用次数", 1000, 2
.ColumnHeaders.Add , , "储物箱", 1500, 2
End With
'显示综合信息
Call AllQry
End Sub
Public Sub AllQry()
Me.LvwAll.ListItems.Clear '清除原有内容
Dim Rs_All As ADODB.Recordset '会员记录集
Set Rs_All = New ADODB.Recordset
Dim Rs_Chest As ADODB.Recordset '储物箱
Set Rs_Chest = New ADODB.Recordset
Dim SQLStr As String 'SQl查询语句
If Me.OptInUsed(0).Value = True Then '正常使用中的卡
SQLStr = "SELECT Member.*,Card.* FROM Card LEFT OUTER JOIN Member ON ( Member.IDCard = Card.UserID AND Card.Deadline >=#" & Format(Now, "short date") & "# )" & " ORDER BY Card.StartingTime"
Rs_All.Open SQLStr, CN, adOpenStatic, adLockOptimistic
' Rs_All.Open "SELECT Member.*,Card.* FROM Member,Card Where Member.IDCard = Card.UserID AND Card.Deadline >=#" & Format(Now, "short date") & "# ORDER BY Card.StartingTime", CN, adOpenStatic, adLockOptimistic
Else '过期卡
'Rs_All.Open "SELECT Member.*,Card.* FROM Member,Card Where Member.IDCard = Card.UserID AND Card.Deadline <=#" & Format(Now, "short date") & "# ORDER BY Card.StartingTime", CN, adOpenStatic, adLockOptimistic
SQLStr = "SELECT Member.*,Card.* FROM Card LEFT OUTER JOIN Member ON ( Member.IDCard = Card.UserID AND Card.Deadline <#" & Format(Now, "short date") & "# )" & " ORDER BY Card.StartingTime"
Rs_All.Open SQLStr, CN, adOpenStatic, adLockOptimistic
End If
Dim i As Long
i = 1
If Not Rs_All.EOF Then
Rs_All.MoveFirst
Do While Not Rs_All.EOF
'读取储物箱信息
Rs_Chest.Open "SELECT Chest.* FROM Chest Where Chest.UserID = '" & Rs_All!IDCard & "'", CN, adOpenStatic, adLockOptimistic
With Me.LvwAll
.ListItems.Add i, , TestNull(Rs_All!IDCard) '身份证
.ListItems(i).SubItems(1) = TestNull(Rs_All!Name) '姓名
.ListItems(i).SubItems(2) = TestNull(Rs_All!Id) '会员卡
.ListItems(i).SubItems(3) = TestNull(Rs_All!StartingTime) '会员卡起始时间
.ListItems(i).SubItems(4) = TestNull(Rs_All!Deadline) '会员卡截止时间
.ListItems(i).SubItems(5) = Val(TestNull(Rs_All!InOutTimes)) '使用次数
'判断该会员是否租用储物箱
If Not Rs_Chest.EOF Then
.ListItems(i).SubItems(6) = TestNull(Rs_Chest!Id) '会员卡截止时间
End If
End With
i = i + 1
Rs_Chest.Close '关闭储物箱记录集
Rs_All.MoveNext
Loop
End If
Rs_All.Close
Set Rs_All = Nothing
Set Rs_Chest = Nothing
End Sub
Private Sub LvwAll_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'单击 ColumnHeader 对象时，将根据
'那一列的子项目把 ListView 控件排序。
'设置 SortKey 为 ColumnHeader 的索引值减 1
' LvwAll.SortKey = ColumnHeader.Index - 1
'*******************************************
'设置 Sorted 为 True 以将列表排序。
LvwAll.Sorted = True
LvwAll.SortOrder = (LvwAll.SortOrder + 1) Mod 2
End Sub
'显示弹出式菜单
Private Sub LvwAll_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If y >= LvwAll.SelectedItem.Top And y <= LvwAll.SelectedItem.Top + LvwAll.SelectedItem.Height Then
Me.PopupMenu MnuLvw
End If
End Sub
'删除
Private Sub mnuDel_Click()
'删除所选的信息
'删除所选会员的全部信息
CN.Execute "DELETE Member.* FROM Member Where Member.IDCard = '" & FrmAllManage.LvwAll.SelectedItem.Text & "'"
'删除所选会员卡的全部信息
CN.Execute "DELETE * FROM Card Where ID ='" & FrmAllManage.LvwAll.SelectedItem.SubItems(2) & "'"
'删除所选会员的储物箱全部信息
CN.Execute "DELETE Chest.* FROM Chest Where Chest.UserID ='" & FrmAllManage.LvwAll.SelectedItem.Text & "'"
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\del.wav", &H1 '当参数为&h0时在播放声音时不响应其他
End If
'************************************
Call Me.AllQry '刷新修改后的信息
End Sub
'修改
Private Sub mnuModify_Click()
FrmAllModify.Show 1
Call Me.AllQry '刷新修改后的信息
End Sub
'查看
Private Sub mnuSee_Click()
FrmMemberShow.Show
End Sub
'查询
Private Sub OptInUsed_Click(Index As Integer)
Call AllQry
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -