📄 frmchestmanage.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form FrmChestManage
Caption = "储物箱管理"
ClientHeight = 5625
ClientLeft = 60
ClientTop = 450
ClientWidth = 8325
Icon = "FrmChestManage.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5625
ScaleWidth = 8325
StartUpPosition = 1 '所有者中心
Begin VB.Frame FraQry
Height = 855
Left = 90
TabIndex = 0
Top = 45
Width = 8055
Begin VB.OptionButton OptInUsed
Caption = "使用中的"
Height = 255
Index = 0
Left = 2040
TabIndex = 2
Top = 360
Value = -1 'True
Width = 1215
End
Begin VB.OptionButton OptInUsed
Caption = "过期或未分配的"
Height = 255
Index = 1
Left = 4005
TabIndex = 1
Top = 360
Width = 1785
End
Begin VB.Label LblInUsed
AutoSize = -1 'True
Caption = "储物箱使用情况:"
Height = 180
Left = 240
TabIndex = 3
Top = 360
Width = 1350
End
End
Begin MSComctlLib.ListView LvwChest
Height = 4395
Left = 135
TabIndex = 4
Top = 990
Width = 8010
_ExtentX = 14129
_ExtentY = 7752
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.Menu mnuChest
Caption = "储物箱"
Visible = 0 'False
Begin VB.Menu mnuModify
Caption = "修改"
End
Begin VB.Menu mnuDel
Caption = "删除"
End
End
End
Attribute VB_Name = "FrmChestManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
With Me.LvwChest
.ColumnHeaders.Add , , "储物箱", 1200
.ColumnHeaders.Add , , "起始日期", 1500, 2
.ColumnHeaders.Add , , "截止日期", 1500, 2
.ColumnHeaders.Add , , "使用者姓名", 1600, 2
.ColumnHeaders.Add , , "使用者身份证号", 1800, 2
End With
'查询
Call ChestQry
End Sub
Public Sub ChestQry()
Me.LvwChest.ListItems.Clear '清除原有内容
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.*,Chest.* FROM Chest LEFT OUTER JOIN Member ON ( Member.IDCard = Chest.UserID AND Chest.Deadline >=#" & Format(Now, "short date") & "# )" & " ORDER BY Chest.StartingTime"
Rs_Chest.Open SQLStr, CN, adOpenStatic, adLockOptimistic
Else '过期卡
SQLStr = "SELECT Member.*,Chest.* FROM Chest LEFT OUTER JOIN Member ON ( Member.IDCard = Chest.UserID AND Chest.Deadline <#" & Format(Now, "short date") & "# )" & " ORDER BY Chest.StartingTime"
Rs_Chest.Open SQLStr, CN, adOpenStatic, adLockOptimistic
End If
Dim i As Long
i = 1
If Not Rs_Chest.EOF Then
Rs_Chest.MoveFirst
Do While Not Rs_Chest.EOF
With Me.LvwChest
.ListItems.Add i, , TestNull(Rs_Chest!Id) '储物箱
.ListItems(i).SubItems(1) = TestNull(Rs_Chest!StartingTime) '储物箱起始时间
.ListItems(i).SubItems(2) = TestNull(Rs_Chest!Deadline) '储物箱截止时间
.ListItems(i).SubItems(3) = TestNull(Rs_Chest!Name) '姓名
.ListItems(i).SubItems(4) = TestNull(Rs_Chest!IDCard) '身份证
End With
i = i + 1
Rs_Chest.MoveNext
Loop
End If
Rs_Chest.Close '关闭储物箱记录集
Set Rs_Chest = Nothing
End Sub
'删除储物箱
Private Sub mnuDel_Click()
'删除所选的信息
'删除所选会员的储物箱全部信息
CN.Execute "DELETE Chest.* FROM Chest Where Chest.ID ='" & Me.LvwChest.SelectedItem.Text & "'"
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\del.wav", &H1 '当参数为&h0时在播放声音时不响应其他
End If
'************************************
Call ChestQry '刷新修改后的信息
End Sub
'修改储物箱
Private Sub mnuModify_Click()
FrmChestModify.Show 1
End Sub
'查询
Private Sub OptInUsed_Click(Index As Integer)
Call ChestQry
End Sub
'显示弹出式菜单
Private Sub LvwChest_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Y >= LvwChest.SelectedItem.Top And Y <= LvwChest.SelectedItem.Top + LvwChest.SelectedItem.Height Then
Me.PopupMenu Me.mnuChest
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -