Top             =   1800
         Width           =   1095
         _ExtentX        =   1931
         _ExtentY        =   609
         Caption         =   "取消"
         CapAlign        =   2
         BackStyle       =   2
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋體"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Mode            =   0
         Value           =   0   'False
         cBack           =   -2147483633
      End
      Begin SuperMarket.XPButton cmdOK 
         Height          =   345
         Left            =   1740
         TabIndex        =   8
         Top             =   1800
         Width           =   1095
         _ExtentX        =   1931
         _ExtentY        =   609
         Caption         =   "確定"
         CapAlign        =   2
         BackStyle       =   2
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "新宋體"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Mode            =   0
         Value           =   0   'False
         cBack           =   -2147483633
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "消費金額："
         Height          =   180
         Left            =   360
         TabIndex        =   13
         Top             =   915
         Width           =   900
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "會員卡號："
         Height          =   180
         Left            =   360
         TabIndex        =   12
         Top             =   435
         Width           =   900
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "登記日期："
         Height          =   180
         Left            =   360
         TabIndex        =   11
         Top             =   1380
         Width           =   900
      End
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "卡號："
      Height          =   180
      Left            =   240
      TabIndex        =   14
      Top             =   720
      Width           =   540
   End
End
Attribute VB_Name = "frmMember"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'超市銷售系統
'程序開發：lc_mtt
'CSDN博客：http://blog.csdn.net/lc_mtt/
'個人主頁：http://www.3lsoft.com
'郵箱：3lsoft@163.com
'注：此代碼禁止用于商業用途。有修改者發我一份，謝謝！
'---------------- 開源世界，你我更進步 ----------------

Private Sub cmdAdd_Click()
On Error GoTo aaaa
    txtCard.Text = Trim(txtCard.Text)
    If txtCard.Text = "" Then txtCard.SetFocus: Exit Sub
    Dim i As Long
    For i = 1 To List1.ListItems.Count
        If StrComp(txtCard.Text, List1.ListItems(i).SubItems(1), 1) = 0 Then
            List1.ListItems(i).Selected = True
            SetSB 2, "找到會員卡 " & txtCard.Text & " ."
            txtCard.Text = ""
            txtCard.SetFocus
            Exit Sub
        End If
    Next
    cnMain.Execute "insert [Member] values('" & txtCard.Text & "',0,'" & FormatDate(Date) & "')"
    Dim Item As ListItem
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    rs.Open "Select TOP 1 * From [Member] order by MemberID Desc", cnMain, 1, 1
    b = CheckOutDate(CDate(rs("RegDate")))
    Set Item = List1.ListItems.Add(1, , rs("MemberID"), , 1)
    Item.SubItems(1) = rs("MemberCard")
    Item.SubItems(2) = rs("TotalCost")
    Item.SubItems(3) = rs("RegDate")
    Item.SubItems(4) = "正常"
    Item.Selected = True
    SetSB 2, "已添加會員卡 " & txtCard.Text & " ."
    txtCard.Text = ""
    txtCard.SetFocus
Exit Sub
aaaa:
    MsgBox Err.Description, vbCritical
    txtCard.SetFocus
End Sub

Public Function FormatDate(ByVal d As Date) As String
    FormatDate = Format(d, "yyyy-mm-dd")
End Function

Private Sub cmdClear_Click()
On Error GoTo aaaa
    Dim i As Long, j As Long, k As Long
    j = List1.ListItems.Count
    If j <= 0 Then
        MsgBox "會員列表為空！", vbInformation
        txtCard.SetFocus
        Exit Sub
    End If
    If MsgBox("這個操作會清理所有的過期會員，請問繼續嗎？", vbOKCancel + vbExclamation + vbDefaultButton2) = vbCancel Then
        txtCard.SetFocus
        Exit Sub
    End If
    For i = j To 1 Step -1
        If List1.ListItems(i).SmallIcon = 2 Then
            cnMain.Execute "Delete From [Member] Where MemberCard='" & List1.ListItems(i).SubItems(1) & "'"
            List1.ListItems.Remove i
            k = k + 1
        End If
    Next
    MsgBox "清理過程順利完成，請看以下統計數據：" & vbCrLf & vbCrLf & "原來會員個數： " & j & vbCrLf & "過期會員個數： " & k & vbCrLf & "現在會員個數： " & List1.ListItems.Count, vbInformation
    SetSB 2, "清理過程順利完成."
    txtCard.SetFocus
Exit Sub
aaaa:
    MsgBox Err.Description, vbCritical
    LoadMemberList
    txtCard.SetFocus
End Sub

Private Sub cmdDel_Click()
On Error GoTo aaaa
    Dim Item As ListItem
    Set Item = List1.SelectedItem
    If MsgBox("確定刪除會員 " & Item.SubItems(1) & " 嗎", vbInformation + vbOKCancel) = vbCancel Then Exit Sub
    cnMain.Execute "Delete From [Member] Where MemberCard='" & Item.SubItems(1) & "'"
    SetSB 2, "刪除會員卡 " & Item.SubItems(1) & " 成功."
    List1.ListItems.Remove Item.Index
    txtCard.SetFocus
Exit Sub
aaaa:
    If Err.Number <> 91 Then MsgBox Err.Description, vbCritical
End Sub

Private Sub cmdEdit_Click()
On Error GoTo aaaa
    Dim Item As ListItem
    Set Item = List1.SelectedItem
    txtCard2.Text = Item.SubItems(1)
    txtCard2.Tag = Item.SubItems(1)
    txtCost.Text = Item.SubItems(2)
    txtCost.Tag = Item.SubItems(2)
    txtDate.Text = Item.SubItems(3)
    txtDate.Tag = Item.SubItems(3)
    ShowItemFrame True
    txtCard2.SetFocus
aaaa:
End Sub

Private Sub cmdExit_Click()
    ShowItemFrame False
    txtCard.SetFocus
End Sub

Private Sub cmdOK_Click()
On Error GoTo aaaa
    txtCard2.Text = Trim(txtCard2.Text)
    If txtCard2.Text = "" Then
        MsgBox "必須填寫會員卡號。", vbInformation
        txtCard2.SetFocus
        Exit Sub
    End If
    cnMain.Execute "UPDATE [Member] SET MemberCard='" & txtCard2.Text & "',TotalCost=" & txtCost.Text & ",RegDate='" & txtDate.Text & "' Where MemberCard='" & txtCard2.Tag & "'"
    Dim Item As ListItem, b As Boolean
    b = CheckOutDate(CDate(txtDate.Text))
    Set Item = List1.SelectedItem
    Item.SmallIcon = IIf(b = False, 1, 2)
    Item.SubItems(1) = txtCard2.Text
    Item.SubItems(2) = txtCost.Text
    Item.SubItems(3) = txtDate.Text
    Item.SubItems(4) = IIf(b = False, "正常", "過期")
    SetSB 2, "修改會員卡 " & txtCard2.Text & " 成功."
    cmdExit_Click
Exit Sub
aaaa:
    MsgBox "操作失敗，可能是該會員卡號已經存在！", vbCritical
End Sub

Private Sub cmdToday_Click()
    txtDate.Text = FormatDate(Date)
End Sub

Private Sub Form_Load()
    Me.WindowState = 2
    imgIcon.Picture = frmMain.cmdLeft(5).Picture
    '讀取會員數據列表
    LoadMemberList
End Sub

'讀取會員數據列表
Public Sub LoadMemberList()
    Dim Item As ListItem, b As Boolean
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    List1.ListItems.Clear
    rs.Open "Select * From [Member] order by MemberID Desc", cnMain, 1, 1
    Do Until rs.EOF
        b = CheckOutDate(CDate(rs("RegDate")))
        Set Item = List1.ListItems.Add(, , rs("MemberID"), , IIf(b = False, 1, 2))
        Item.SubItems(1) = rs("MemberCard")
        Item.SubItems(2) = rs("TotalCost")
        Item.SubItems(3) = rs("RegDate")
        Item.SubItems(4) = IIf(b = False, "正常", "過期")
        rs.MoveNext
    Loop
    SetSB 2, "共 " & rs.RecordCount & " 條會員記錄."
End Sub

Public Function CheckOutDate(ByVal d As Date) As Boolean
    Dim j1 As Long, j2 As Long, j3 As Long
    j1 = Year(Date) - Year(d)
    j2 = Month(Date) - Month(d)
    j3 = Day(Date) - Day(d)
    If j1 > 1 Then
        CheckOutDate = True
    Else
        CheckOutDate = (j1 + j2 + j3 > 0)
    End If
End Function

Public Sub ShowItemFrame(ByVal b As Boolean)
    List1.Visible = Not b
    freItem.Visible = b
    cmdDel.Enabled = Not b
    cmdClear.Enabled = Not b
    cmdEdit.Enabled = Not b
    cmdAdd.Enabled = Not b
    txtCard.Enabled = Not b
    cmdAdd.Default = Not b
    cmdOK.Default = b
End Sub

Private Sub Form_Resize()
On Error Resume Next
    List1.Width = Width / 15 - 38
    List1.Height = Me.Height / 15 - 144
    PicTop.Width = Width / 15 - 16
    Cls
    Line (2, 2)-(Width / 15 - 14, Height / 15 - 29), 10921638, B
End Sub

Private Sub List1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
On Error Resume Next
    With List1
        If (ColumnHeader.Index - 1) = .SortKey Then
            .SortOrder = 1 - .SortOrder
            .Sorted = True
        Else
            .Sorted = False
            .SortOrder = 0
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
        End If
    End With
End Sub

Private Sub List1_DblClick()
On Error GoTo aaaa
    Dim j As Long
    j = List1.SelectedItem.Index
    cmdEdit_Click
aaaa:
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo aaaa
    If KeyCode = vbKeyDelete Then
        Dim j As Long
        j = List1.SelectedItem.Index
        cmdDel_Click
    End If
aaaa:
End Sub

Private Sub txtCost_LostFocus()
On Error GoTo aaaa
    Dim c As Currency
    c = CCur(txtCost.Text)
Exit Sub
aaaa:
    txtCost.Text = txtCost.Tag
End Sub

Private Sub txtDate_LostFocus()
On Error GoTo aaaa
    Dim d As Date
    d = CDate(txtDate.Text)
Exit Sub
aaaa:
    txtDate.Text = txtDate.Tag
End Sub