📄 form2.frm
字号:
Left = 8340
TabIndex = 15
Top = 900
Width = 1260
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "联系手机："
Height = 180
Left = 4740
TabIndex = 14
Top = 1980
Width = 900
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "电子邮件："
Height = 180
Left = 4740
TabIndex = 13
Top = 1680
Width = 900
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "累计金额："
Height = 180
Left = 4740
TabIndex = 12
Top = 1260
Width = 900
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "会员姓名："
Height = 180
Left = 4740
TabIndex = 11
Top = 900
Width = 900
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "会员照片："
Height = 180
Left = 2220
TabIndex = 10
Top = 2280
Width = 900
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "会员卡级别："
Height = 180
Left = 11520
TabIndex = 9
Top = 900
Width = 1080
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单位职业："
Height = 180
Left = 2220
TabIndex = 8
Top = 1680
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "卡内余额："
Height = 180
Left = 2220
TabIndex = 7
Top = 1260
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "会员卡号："
Height = 180
Left = 2220
TabIndex = 6
Top = 900
Width = 900
End
Begin VB.Line Line1
BorderColor = &H80000010&
X1 = 1920
X2 = 15240
Y1 = 780
Y2 = 780
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请输入会员编号或姓名"
Height = 180
Left = 2040
TabIndex = 0
Top = 360
Width = 1800
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public ConsumePas As String
Private Sub Command1_Click()
query_Form
End Sub
Private Sub Command3_Click()
Form8.Show
End Sub
Private Sub Command4_Click()
qingkong
End Sub
Private Sub Command5_Click()
If Label22.caption = "" Then
MsgBox "请您选择会员", vbCritical + vbOKOnly
ElseIf Label34.caption < 3 Then
MsgBox "当前金额为0请充值", vbCritical + vbQuestion
Else
Form11.Show
End If
End Sub
Private Sub Command9_Click()
Form2.Visible = False
Form3.Show
Form3.WindowState = 2
Form3.listlogin
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
qingkong
query_Form
End Sub
Private Sub Form_Load()
XPM1.Add "删除消费记录", Im1.Picture
XPM1.AddLine
XPM1.Add "增加消费记录", Im2.Picture
XPM1.Add "修改消费记录", Im3.Picture
'设置顶行显示
ListView1.ColumnHeaders.Add , , "消费日期", 2440
ListView1.ColumnHeaders.Add , , "消费金额", 2000
ListView1.ColumnHeaders.Add , , "备注", 2230
Dim strDBName As String
strDBName = App.Path
If Right(strDBName, 1) <> "\" Then strDBName = strDBName & "\"
strDBName = strDBName & "data\dbdata.MDB" '数据库物理文件名称，相对路径
'连接到数据库
If ConnectToServer(strDBName) = False Then
MsgBox "连接数据库错误,请确认数据库是否存在;应用程序将退出...", vbCritical + vbOKOnly, "数据库错误"
End
Else
'连接成功，则取所有的客户信息，并且显示在ListView控件中...
'Call GetAllCustomerInfoFromDB
End If
Form2.WindowState = 2
BSE1.SchemeStyle = 0
BSE1.EndSubClassing
BSE1.InitSubClassing
End Sub
'取数据库dbdata,MDB的客户信息表Customer所有的信息，并且显示在ListView控件中
Private Function GetAllCustomerInfoFromDB() As Boolean
On Error Resume Next
Dim intindex As Long
If RunSQL("SELECT * FROM customer") = False Then
MsgBox "运行时错误，不能取得客户信息...", vbInformation + vbOKOnly, "运行错误"
Exit Function
Else
ListView1.ListItems.Clear
'没有任何客户信息的情况
If rctrecordset.EOF And rctrecordset.BOF Then Exit Function
rctrecordset.MoveFirst
Dim lstitem As ListItem
Do While Not rctrecordset.EOF '循环读取... ...
Set lstitem = ListView1.ListItems.Add(, "K_" & CStr(rctrecordset.Fields("CustomerID").Value), rctrecordset.Fields("xiaofeiriqi").Value)
'注意：SubItems的集合元素下标从1开始
lstitem.SubItems(1) = rctrecordset.Fields("xiaofeicishu").Value
lstitem.SubItems(2) = rctrecordset.Fields("beizhu").Value
'Tag值保存主键值
lstitem.Tag = CStr(rctrecordset.Fields("CustomerID").Value)
rctrecordset.MoveNext
Loop
End If
End Function
Private Sub Form_Unload(Cancel As Integer)
'在窗体关闭的时候，断开连接
Call CloseConnect
End Sub
Sub query_Form()
On Error GoTo SysInfoErr
Dim strSQL As String
Dim intindex As Long
Dim lstitem As ListItem
Dim count As String
If Not Text1.Text = "" Then
strSQL = "select * from hyxx,customer where hyxx.会员卡号=customer.卡号 and 会员卡号='" & Text1.Text & "'"
ListView1.ListItems.Clear
If RunSQL(strSQL) = True Then 'And Not rctrecordset.EOF Then
Label41.caption = rctrecordset.Fields("id").Value
Label22.caption = rctrecordset.Fields("会员卡号").Value
Label23.caption = rctrecordset.Fields("会员姓名").Value
Label24.caption = rctrecordset.Fields("会员卡类型").Value
Label25.caption = rctrecordset.Fields("卡的级别").Value
Label26.caption = rctrecordset.Fields("会员状态").Value
'Label27.Caption = rctrecordset.Fields("总共消费次数").Value
Label28.caption = rctrecordset.Fields("证件类型").Value
Label29.caption = rctrecordset.Fields("联系地址").Value
Label30.caption = rctrecordset.Fields("会员金额").Value
Label31.caption = rctrecordset.Fields("电子邮件").Value
Label32.caption = rctrecordset.Fields("用户手机").Value
Label33.caption = rctrecordset.Fields("其他信息").Value
Label34.caption = rctrecordset.Fields("卡内金额").Value
Label35.caption = rctrecordset.Fields("单位职业").Value
Label36.caption = rctrecordset.Fields("用户电话").Value
'Label37.Caption = rctrecordset.Fields("会员照片").Value
Label38.caption = rctrecordset.Fields("证件号码").Value
ConsumePas = rctrecordset.Fields("卡号密码").Value
ListView1.ListItems.Clear
rctrecordset.MoveFirst
count = 0
Do While Not rctrecordset.EOF '循环读取... ...
Set lstitem = ListView1.ListItems.Add(, "K_" & CStr(rctrecordset.Fields("CustomerID").Value), rctrecordset.Fields("xiaofeiriqi").Value)
'SubItems的集合元素下标从1开始
lstitem.SubItems(1) = rctrecordset.Fields("xiaofeicishu").Value
lstitem.SubItems(2) = rctrecordset.Fields("beizhu").Value
'Tag值保存主键值
lstitem.Tag = CStr(rctrecordset.Fields("CustomerID").Value)
rctrecordset.MoveNext
count = count + 1
Loop
Label39.caption = "当前共有" + count + "条消费记录"
Label40.caption = count
Label27.caption = count
End If
Else
'MsgBox "输入错误不能为空", , "系统提示"
End If
SysInfoErr:
End Sub
Private Sub ListView1_DblClick()
'XPM1.ShowMenu True, 0, 0
End Sub
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'设置右键事件
If Button = vbRightButton Then XPM1.ShowMenu True, 0, 0
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Command5_Click
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Then
ElseIf KeyAscii = 8 Then
KeyAscii = 8
Else
KeyAscii = 0
End If
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
'排序
Dim currSortKey As Integer
ListView1.SortKey = ColumnHeader.index - 1
currSortKey = ListView1.SortKey
ListView1.SortOrder = Abs(Not ListView1.SortOrder = 1)
ListView1.Sorted = True
If currSortKey > -1 Then
'prevOrder% = currSortKey
End If
End Sub
Sub qingkong()
Label22.caption = ""
Label23.caption = ""
Label24.caption = ""
Label25.caption = ""
Label26.caption = ""
Label27.caption = ""
Label28.caption = ""
Label29.caption = ""
Label30.caption = ""
Label31.caption = ""
Label32.caption = ""
Label33.caption = ""
Label34.caption = ""
Label35.caption = ""
Label36.caption = ""
'Label37.Caption =""
Label38.caption = ""
End Sub
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub XPM1_Click(index As Long)
Select Case index
Case 1
'如果当前没有选择的客户，则不执行任何操作
If ListView1.SelectedItem Is Nothing Then Exit Sub
'删除确认
If MsgBox("确认要删除日期为 " & ListView1.SelectedItem.Text & " 吗？", vbYesNo + vbQuestion, "删除客户消费记录") = vbNo Then Exit Sub
If RunSQL("DELETE FROM CUSTOMER WHERE CustomerID = " & ListView1.SelectedItem.Tag) = True Then
'如果删除成功，则从LISTVIEW控件中也删除对应的节点，以保持与数据库的同步
ListView1.ListItems.Remove (ListView1.SelectedItem.Key)
End If
Case 2
Command5_Click
Case Else
MsgBox "您无法修改消费记录", vbCritical + vbQuestion
'MsgBox "你按了：" & XPM1.GetCaption(index)
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -