?? frmmember.frm
字號:
_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 MySuperMarket.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
' **********************************************************************
' 描 述：超市銷售系統源代碼
' Play78.com : 網站導航，源碼之家，絕對開源
' 海闊天空收集整理
' 主站地址：http://www.play78.com/
' 源碼下載地址：http://www.play78.com/blog
' 圖片下在地址：http://www.play78.com/pic
' QQ：13355575
' e-mail:hglai@eyou.com
' 編寫日期：2005年08月14日
' **********************************************************************
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -