consume.frm

会员消费积分管理系统

VERSION 5.00
Begin VB.Form consume 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "consume list"
   ClientHeight    =   5325
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7440
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5325
   ScaleWidth      =   7440
   Begin VB.CommandButton reportcomm 
      Caption         =   "报表"
      Height          =   495
      Left            =   5760
      TabIndex        =   20
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton Find_Comm 
      Caption         =   "查找"
      Height          =   495
      Left            =   4440
      TabIndex        =   18
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton AddConsume_Comm 
      Caption         =   "添加"
      Height          =   495
      Left            =   3000
      TabIndex        =   17
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton Change_Comm 
      Caption         =   "修改"
      Height          =   495
      Left            =   1560
      TabIndex        =   16
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton Del_Member_comm 
      Caption         =   "删除"
      Height          =   495
      Left            =   240
      TabIndex        =   15
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton Last_comm 
      Caption         =   ">>"
      Height          =   495
      Left            =   4440
      TabIndex        =   14
      Top             =   4080
      Width           =   1215
   End
   Begin VB.CommandButton Front_comm 
      Caption         =   "<<"
      Height          =   495
      Left            =   240
      TabIndex        =   13
      Top             =   4080
      Width           =   1215
   End
   Begin VB.CommandButton Next_Comm 
      Caption         =   ">"
      Height          =   495
      Left            =   3000
      TabIndex        =   12
      Top             =   4080
      Width           =   1215
   End
   Begin VB.CommandButton previous_comm 
      Caption         =   "<"
      Height          =   495
      Left            =   1560
      TabIndex        =   6
      Top             =   4080
      Width           =   1215
   End
   Begin VB.TextBox Text6 
      Height          =   495
      Left            =   1440
      TabIndex        =   5
      Top             =   3120
      Width           =   3015
   End
   Begin VB.TextBox Text5 
      Height          =   495
      Left            =   1440
      TabIndex        =   4
      Top             =   2520
      Width           =   3015
   End
   Begin VB.TextBox Text4 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "yyyy-M-d"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   3
      EndProperty
      Height          =   495
      Left            =   1440
      TabIndex        =   3
      Top             =   1920
      Width           =   3015
   End
   Begin VB.TextBox Text3 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "0"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   1
      EndProperty
      Height          =   495
      Left            =   1440
      TabIndex        =   2
      Text            =   "0"
      Top             =   1320
      Width           =   3015
   End
   Begin VB.TextBox Text2 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "0.00"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   1
      EndProperty
      Height          =   495
      Left            =   1440
      TabIndex        =   1
      Text            =   "0"
      Top             =   720
      Width           =   3015
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   1440
      TabIndex        =   0
      Top             =   120
      Width           =   3015
   End
   Begin VB.Label Label6 
      Caption         =   "当前记录:"
      Height          =   375
      Left            =   120
      TabIndex        =   19
      Top             =   3240
      Width           =   855
   End
   Begin VB.Label Label5 
      Caption         =   "消费总数:"
      Height          =   375
      Left            =   120
      TabIndex        =   11
      Top             =   2520
      Width           =   1215
   End
   Begin VB.Label Label4 
      Caption         =   "消费时间:"
      Height          =   495
      Left            =   120
      TabIndex        =   10
      Top             =   1920
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "卡号.:"
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   1440
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "消费额:"
      Height          =   375
      Left            =   120
      TabIndex        =   8
      Top             =   720
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "用户名:"
      Height          =   375
      Left            =   120
      TabIndex        =   7
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "consume"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Public search_str As String
Public ocn As New Class1
Public rs As New Class1
Public DelID As Integer, Auto_id As Integer

Private Sub AddConsume_Comm_Click()
Add_Consume_Form.Text1 = Me.Text3.Text
Add_Consume_Form.Show

End Sub

Private Sub Change_Comm_Click()
Dim myxf As Single
ocn.ocn.Execute ("update xflist set username='" & Text1.Text & "',xf='" & Text2.Text & "',cardno='" & CLng(Text3.Text) & "',xftime='" & CDate(Text4.Text) & "' where auto_id=" & Auto_id)

If rs.rs.State = 1 Then
rs.rs.Close
Set rs.rs = Nothing
rs.rs.Open "select sum(xf) from xflist where id=" & DelID, ocn.ocn, 1, 1
myxf = CSng(rs.rs.Fields.Item(0).Value)
ocn.ocn.Execute ("update userlist set allxf='" & myxf & "' where id=" & DelID)
End If

If rs.rs.State = 1 Then
rs.rs.Close
Set rs.rs = Nothing
End If

    rs.rs.Open "select*from xflist where id = " & Auto_id, ocn.ocn, 1, 1
    If Not rs.rs.BOF And Not rs.rs.EOF Then
        Text1.Text = rs.rs("username")
        Text2.Text = rs.rs("xf")
        Text3.Text = rs.rs("cardno")
        Text4.Text = rs.rs("xftime")
        Text5.Text = rs.rs.RecordCount
        Text6.Text = rs.rs.AbsolutePosition
        DelID = rs.rs("id")
        Auto_id = rs.rs("auto_id")
        Me.Caption = DelID
    End If
    




End Sub

Private Sub Del_Member_comm_Click()
Dim RealDel As Integer
RealDel = MsgBox("Are you sure?", vbYesNo)
If RealDel = 6 Then
On Error Resume Next
ocn.ocn.Execute ("delete*from xflist where auto_id=" & Auto_id)
If rs.rs.State = 1 Then rs.rs.Requery
End If
If rs.rs.State = 1 Then
rs.rs.Close
Set rs.rs = Nothing
rs.rs.Open "select sum(xf) from xflist where id=" & DelID, ocn.ocn, 1, 1
myxf = CSng(rs.rs.Fields.Item(0).Value)
ocn.ocn.Execute ("update userlist set allxf='" & myxf & "' where id=" & DelID)
End If
If rs.rs.State = 1 Then
rs.rs.Close
Set rs.rs = Nothing
End If

End Sub

Private Sub Find_Comm_Click()
Call FindConsume

End Sub

Private Sub Form_Load()
search_str = InputBox("请输入卡号")
If frmLogin.Popedom <> 1 Then
With Me
.Del_Member_comm.Enabled = False
.Change_Comm.Enabled = False
.AddConsume_Comm.Enabled = False
End With
End If
'If search_str = Null Then Exit Sub

If IsNumeric(search_str) = True Then
search_str = CInt(search_str)
Else
MsgBox "请输入数值型"
search_str = 0
search_str = InputBox("请输入卡号")

End If

'If search_str <> Null Then
    If ocn.ocn.State = False Then
        ocn.ocn.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\DATA.mdb;Persist security info=false"
        ocn.ocn.Open
    End If
    If rs.rs.State = 1 Then
        rs.rs.Close
        Set rs.rs = Nothing
    End If
On Error Resume Next
    rs.rs.Open "select*from xflist where cardno = " & search_str, ocn.ocn, 1, 1
    If Not rs.rs.BOF And Not rs.rs.EOF Then
        Text1.Text = rs.rs("username")
        Text2.Text = rs.rs("xf")
        Text3.Text = rs.rs("cardno")
        Text4.Text = rs.rs("xftime")
        Text5.Text = rs.rs.RecordCount
        Text6.Text = rs.rs.AbsolutePosition
        DelID = rs.rs("id")
        Auto_id = rs.rs("auto_id")
        Me.Caption = DelID
    If frmLogin.Popedom = 1 Then
    Del_Member_comm.Enabled = True
    Change_Comm.Enabled = True
    End If
    
    Front_comm.Enabled = True
    Previous_Comm.Enabled = True
    Next_Comm.Enabled = True
    Last_Comm.Enabled = True
    
    Else
    Del_Member_comm.Enabled = False
    Front_comm.Enabled = False
    Previous_Comm.Enabled = False
    Next_Comm.Enabled = False
    Last_Comm.Enabled = False
    Change_Comm.Enabled = False
    End If
'End If
End Sub
Sub FindConsume() '查找消费记录自定义函数
Dim search_str As String

search_str = InputBox("please input keyword for you want to find")
If frmLogin.Popedom <> 1 Then
With consume
.Del_Member_comm.Enabled = False
.Change_Comm.Enabled = False
.AddConsume_Comm.Enabled = False
End With
End If
'If search_str = Null Then Exit Sub

If IsNumeric(search_str) = True Then
search_str = CInt(search_str)
Else
MsgBox "请输入数值型"
search_str = 0
search_str = InputBox("请输入卡号")

End If

'If search_str <> Null Then
    If ocn.ocn.State = False Then
        ocn.ocn.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=DATA.mdb;Persist security info=false"
        ocn.ocn.Open
    End If
    If rs.rs.State = 1 Then
        rs.rs.Close
        Set rs.rs = Nothing
    End If
On Error Resume Next
    rs.rs.Open "select*from xflist where cardno = " & search_str, ocn.ocn, 1, 1
    If Not rs.rs.BOF And Not rs.rs.EOF Then
        Text1.Text = rs.rs("username")
        Text2.Text = rs.rs("xf")
        Text3.Text = rs.rs("cardno")
        Text4.Text = rs.rs("xftime")
        Text5.Text = rs.rs.RecordCount
        Text6.Text = rs.rs.AbsolutePosition
        DelID = rs.rs("id")
        Auto_id = rs.rs("auto_id")
        Me.Caption = DelID
    If frmLogin.Popedom = 1 Then
    Del_Member_comm.Enabled = True
   Change_Comm.Enabled = True
   End If
    Front_comm.Enabled = True
    Previous_Comm.Enabled = True
    Next_Comm.Enabled = True
    Last_Comm.Enabled = True
    

    Else
    Del_Member_comm.Enabled = False
    Front_comm.Enabled = False
    Previous_Comm.Enabled = False
    Next_Comm.Enabled = False
    Last_Comm.Enabled = False
    Change_Comm.Enabled = False
    End If

End Sub



Private Sub Front_comm_Click()
If rs.rs.State = False Then Exit Sub
rs.rs.Requery
If Not rs.rs.BOF Then
rs.rs.MoveFirst
If Not rs.rs.BOF Then
Text1.Text = rs.rs("username")
Text2.Text = rs.rs("xf")
Text3.Text = rs.rs("cardno")
Text4.Text = rs.rs("xftime")
Text5.Text = rs.rs.RecordCount
Text6.Text = rs.rs.AbsolutePosition
DelID = rs.rs("id")
Auto_id = rs.rs("auto_id")
Me.Caption = DelID
End If
End If


End Sub

Private Sub Last_Comm_Click()
If rs.rs.State = False Then Exit Sub
rs.rs.Requery
If Not rs.rs.EOF Then
rs.rs.MoveLast
If Not rs.rs.EOF Then
Text1.Text = rs.rs("username")
Text2.Text = rs.rs("xf")
Text3.Text = rs.rs("cardno")
Text4.Text = rs.rs("xftime")
Text5.Text = rs.rs.RecordCount
Text6.Text = rs.rs.AbsolutePosition

DelID = rs.rs("id")
Auto_id = rs.rs("auto_id")

Me.Caption = DelID
End If
End If

End Sub

Private Sub Next_Comm_Click()
If rs.rs.State = 1 Then
If Not rs.rs.EOF Then
rs.rs.MoveNext
If Not rs.rs.EOF Then
Text1.Text = rs.rs("username")
Text2.Text = rs.rs("xf")
Text3.Text = rs.rs("cardno")
Text4.Text = rs.rs("xftime")
Text5.Text = rs.rs.RecordCount
Text6.Text = rs.rs.AbsolutePosition
DelID = rs.rs("id")
Auto_id = rs.rs("auto_id")
Me.Caption = DelID

End If
End If
End If
End Sub

Private Sub Previous_Comm_Click()
If rs.rs.State = False Then Exit Sub

If Not rs.rs.BOF Then
rs.rs.MovePrevious
If Not rs.rs.BOF Then
Text1.Text = rs.rs("username")
Text2.Text = rs.rs("xf")
Text3.Text = rs.rs("cardno")
Text4.Text = rs.rs("xftime")
Text5.Text = rs.rs.RecordCount
Text6.Text = rs.rs.AbsolutePosition
DelID = rs.rs("id")
Auto_id = rs.rs("auto_id")
Me.Caption = DelID

End If
End If



End Sub

Private Sub Refresh_comm_Click()

End Sub

Private Sub reportcomm_Click()
      Dim strSQL As String
      If DataEnv.xfcommand.State = 1 Then
      DataEnv.xfcommand.Close
      End If
      
      strSQL = "select * from xflist where cardno =" & search_str
         
      DataEnv.xfcommand.Open strSQL
      DataReport2.Show

End Sub

Private Sub Text2_Change()
If IsNumeric(Text2.Text) = False Then
MsgBox "data is not allowed"
Text2.SetFocus
End If

End Sub

Private Sub Text3_Change()
If IsNumeric(Text3.Text) = False Then
MsgBox "data is not allowed"
Text3.SetFocus
End If

End Sub

Private Sub Text4_Change()
If IsDate(Text4.Text) = False Then
MsgBox "Data is not allowed"
Text4.SetFocus
End If
End Sub