frm_xfcx.frm

一个完整的非接触IC卡会员管理系统

    sWhere = sWhere & IIf(Len(Trim(r_iccardid.Text)) = 0, "", " IC卡号= '" & Format(r_iccardid.Text, "00000000") & "' and ")
    sWhere = sWhere & IIf(Len(Trim(r_cardtype.Text)) = 0, "", " IC卡类= '" & Format(sTypeid, "00") & "' and ")
    sWhere = sWhere & IIf(Len(Trim(r_bh.Text)) = 0, "", " 员工编号= '" & Format(r_bh.Text, "00000000") & "' and ")
    sWhere = sWhere & IIf(Len(Trim(r_bm.Text)) = 0, "", " 部门= '" & r_bm.Text & "' and ")
        
    If DTPickerr2 < DTPickerr1 Or DTPickerr1 = "" Or DTPickerr2 = "" Then MsgBox "日期条件有错误！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
    sWhere = sWhere & " 消费时间 >= '" & Format(DTPickerr1.Value, "yyyy-mm-dd") & "' and "
    sWhere = sWhere & " 消费时间 <= '" & Format(DTPickerr2.Value, "yyyy-mm-dd") & " 23:59:59' and "
    
    If Len(Trim(sWhere)) > 0 Then
       sWhere = Left(sWhere, Len(sWhere) - 4)
       sWhere = " where " & sWhere
    End If
    sWhere1 = sWhere & " order by 消费时间"
    sWhere = " select *  from 消费明细" & sWhere & " order by 消费时间"
    
    maSys_db.Execute "delete from 消费明细临时"
    pssql = "insert into 消费明细临时 select IC卡号,IC卡类,员工编号,设备号,消费金额,卡上余额,消费时间,部门,司机,消费类型 from 消费明细 " & sWhere1
    maSys_db.Execute pssql
        
    Rs_Record_Set
End If
End Sub

Private Sub cmdxfr_Click()
'Dim rSellCount As Integer
'Dim rSellMoney As Currency
'Dim rpMoney As Currency
'Dim rSellTimes As Long
'Dim rpTimes As Long
'Dim rTurnCount As Long
'Dim rTurnMoney As Currency
If Option3.Value = True Then '售卡充值
    If Option1.Value = True Then
         With CrystalReport1
            .Connect = maSys_db.ConnectionString
            .WindowState = crptMaximized
            .ReportFileName = App.Path + "\fullmx.rpt"
            .Action = 1
         End With
    Else
        With CrystalReport1
            .Connect = maSys_db.ConnectionString
            .WindowState = crptMaximized
            .ReportFileName = App.Path + "\fullhz.rpt"
'            .Formulas(0) = "SellCount='" & rSellCount & "'"
'            .Formulas(1) = "SellMoney='" & rSellMoney & "'"
'            .Formulas(2) = "pMoney='" & -rpMoney & "'"
'            .Formulas(3) = "SellTimes='" & rSellTimes & "'"
'            .Formulas(4) = "pTimes='" & rpTimes & "'"
'            .Formulas(5) = "TurnCount='" & rTurnCount & "'"
'            .Formulas(6) = "TurnMoney='" & rTurnMoney & "'"
'            .Formulas(7) = "date1='" & DTPickerf1.Value & "'"
'            .Formulas(8) = "date2='" & DTPickerf2.Value & "'"
'            .Formulas(9) = "SumMoney='" & rSellMoney - rpMoney + rTurnMoney & "'"
            .Action = 1
        End With
    End If
Else
    If Option1.Value = True Then
         With CrystalReport1
            .Connect = maSys_db.ConnectionString
            .WindowState = crptMaximized
            .ReportFileName = App.Path + "\xfmx.rpt"
            .Action = 1
         End With
    Else
        With CrystalReport1
            .Connect = maSys_db.ConnectionString
            .WindowState = crptMaximized
            .ReportFileName = App.Path + "\xfhz.rpt"
'            .Formulas(0) = "SellCount='" & rSellCount & "'"
'            .Formulas(1) = "SellMoney='" & rSellMoney & "'"
'            .Formulas(2) = "pMoney='" & -rpMoney & "'"
'            .Formulas(3) = "SellTimes='" & rSellTimes & "'"
'            .Formulas(4) = "pTimes='" & rpTimes & "'"
'            .Formulas(5) = "TurnCount='" & rTurnCount & "'"
'            .Formulas(6) = "TurnMoney='" & rTurnMoney & "'"
'            .Formulas(7) = "date1='" & DTPickerf1.Value & "'"
'            .Formulas(8) = "date2='" & DTPickerf2.Value & "'"
'            .Formulas(9) = "SumMoney='" & rSellMoney - rpMoney + rTurnMoney & "'"
            .Action = 1
        End With
    End If

End If

End Sub

Private Sub Combo3_Click() '结算标志
If Combo3.Text = "未结算" Then
    sJS = "0"
ElseIf Combo3.Text = "已结算" Then
    sJS = "1"
Else
    sJS = ""
End If
End Sub

'Private Sub f_bh_KeyPress(KeyAscii As Integer)
'If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
'        KeyAscii = 0
'End If
'End Sub

'Private Sub r_bh_KeyPress(KeyAscii As Integer)
'If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
'        KeyAscii = 0
'End If
'End Sub

Private Sub r_dev_KeyPress(KeyAscii As Integer)
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
        KeyAscii = 0
End If
End Sub

Private Sub f_cardtype_Click()
If f_cardtype.ListCount > 0 Then
    sListNo = f_cardtype.ListIndex
    sTypeid = sType(sListNo)
End If
End Sub

Private Sub r_cardtype_Click()
If r_cardtype.ListCount > 0 Then
    sListNo = r_cardtype.ListIndex
    sTypeid = sType(sListNo)
End If
End Sub

Private Sub f_iccardid_KeyPress(KeyAscii As Integer)
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
        KeyAscii = 0
End If
End Sub

Private Sub r_iccardid_KeyPress(KeyAscii As Integer)
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
        KeyAscii = 0
End If
End Sub

Private Sub Form_Load()
Me.Top = (Screen.Height - Me.Height) / 2 + 300
Me.Left = (Screen.Width - Me.Width) / 2
'DTP_xfdate = Format(Now, "yyyy-mm-dd")
'DTP_xfdate1 = Format(Now, "yyyy-mm-dd")
'Combo3.Clear
'Combo3.AddItem "已结算"
'Combo3.AddItem "未结算"
'Call sHymc
'Call sxfxm
DTPickerf1.Value = Format(Now, "yyyy-mm-dd")
DTPickerf2.Value = Format(Now, "yyyy-mm-dd")
Call sGetCardtype
Call sGetDotype

End Sub

Private Sub sGetBm()
    Dim i As Integer
    Set rs = GetRecordset(maSys_db, "select * from dept_dict")
    If Not rs.EOF Then
          r_bm.Clear
          i = 0
          Do While Not rs.EOF
             r_bm.AddItem Trim(rs!dept_name)
             rs.MoveNext
          Loop
    End If
End Sub

Private Sub sGetCardtype() 'f_cardtype
Set rs = GetRecordset(maSys_db, "select * from 会员类型设置表")
If rs.EOF Then
    Exit Sub
Else
    If Option3.Value = True Then
        f_cardtype.Clear
    Else
        r_cardtype.Clear
    End If
    rs.MoveFirst
    sListNo = 0
    Do While Not rs.EOF
        If Option3.Value = True Then
            f_cardtype.AddItem rs.Fields("类型名称")
        Else
            r_cardtype.AddItem rs.Fields("类型名称")
        End If
        sType(sListNo) = rs.Fields("类型编号")
        sListNo = sListNo + 1
        rs.MoveNext
    Loop
End If
End Sub

Private Sub sGetDotype()
f_do.Clear
f_do.AddItem "售卡"
f_do.AddItem "退卡"
f_do.AddItem "充值"
f_do.AddItem "充正"
f_do.AddItem "充次"
f_do.AddItem "减次"

End Sub

Private Sub Rs_Record_Set() '显示记录到listview
Dim L As ListItem
Dim i As Integer

Set rs = GetRecordset(maSys_db, sWhere)

ListViewxf.ColumnHeaders.Clear
ListViewxf.ListItems.Clear
ListViewxf.View = lvwReport
ListViewxf.ColumnHeaders.Add , , "ID", 800
ListViewxf.ColumnHeaders.Add , , "IC卡号", 1500
ListViewxf.ColumnHeaders.Add , , "IC卡类", 1400
ListViewxf.ColumnHeaders.Add , , "员工编号", 1400
ListViewxf.ColumnHeaders.Add , , "设备号", 1400
ListViewxf.ColumnHeaders.Add , , "消费金额", 1400
ListViewxf.ColumnHeaders.Add , , "卡上余额", 1400
ListViewxf.ColumnHeaders.Add , , "消费时间", 1400
ListViewxf.ColumnHeaders.Add , , "部门", 2500
ListViewxf.ColumnHeaders.Add , , "司机", 1200
ListViewxf.ColumnHeaders.Add , , "消费类型", 1200

i = 1
If rs.EOF Then
   Exit Sub
Else
    rs.MoveFirst
    Do While Not rs.EOF
        Set L = ListViewxf.ListItems.Add(, , i)
            L.SubItems(1) = CStr(rs!IC卡号)
            L.SubItems(2) = CStr(rs!IC卡类)
            L.SubItems(3) = CStr(rs!员工编号)
            L.SubItems(4) = CStr(rs!设备号)
            L.SubItems(5) = CStr(rs!消费金额)
            L.SubItems(6) = CStr(rs!卡上余额)
            L.SubItems(7) = CStr(rs!消费时间)
            L.SubItems(8) = CStr(rs!部门)
            L.SubItems(9) = CStr(rs!司机)
            L.SubItems(10) = Trim(" " & rs!消费类型)
        i = i + 1
        rs.MoveNext
    Loop
End If
End Sub

Private Sub listrecord()
Dim L As ListItem
Dim i As Integer

Set rs = GetRecordset(maSys_db, sWhere)
ListViewxf.ColumnHeaders.Clear
ListViewxf.ListItems.Clear
ListViewxf.View = lvwReport
ListViewxf.ColumnHeaders.Add , , "ID", 800
ListViewxf.ColumnHeaders.Add , , "IC卡号", 1400
ListViewxf.ColumnHeaders.Add , , "员工编号", 1400
ListViewxf.ColumnHeaders.Add , , "卡上余额", 1400
ListViewxf.ColumnHeaders.Add , , "充值金额", 1400
ListViewxf.ColumnHeaders.Add , , "操作类型", 1400
ListViewxf.ColumnHeaders.Add , , "次数", 1100
ListViewxf.ColumnHeaders.Add , , "操作员", 1100
ListViewxf.ColumnHeaders.Add , , "操作时间", 2500
ListViewxf.ColumnHeaders.Add , , "IC卡类型", 1400
ListViewxf.ColumnHeaders.Add , , "月份", 1400
i = 1
rSellCount = 0
rSellMoney = 0
rpMoney = 0
rSellTimes = 0
rpTimes = 0
rTurnCount = 0
rTurnMoney = 0
If rs.EOF Then Exit Sub

rs.MoveFirst
Do While Not rs.EOF
'    Dim rSellCount As Integer
'    Dim rSellMoney As Currency
'    Dim rpMoney As Currency
'    Dim rSellTimes As Long
'    Dim rpTimes As Long
'    Dim rTurnCount As Long
'    Dim rTurnMoney As Currency
    
    Select Case rs!操作类型
    Case "售卡"
        rSellCount = rSellCount + 1
    Case "充值"
        rSellMoney = rSellMoney + rs!充值金额
    Case "充正"
        rpMoney = rpMoney + rs!充值金额
    Case "充次"
        rSellTimes = rSellTimes + rs!赠送积分
    Case "减次"
        rpTimes = rpTimes + rs!赠送积分
    Case "退卡"
        rTurnCount = rTurnCount + 1
        rTurnMoney = rTurnMoney + rs!充值金额
    End Select
    
    Set L = ListViewxf.ListItems.Add(, , i)
        L.SubItems(1) = CStr(rs!IC卡号)
        L.SubItems(2) = CStr(rs!员工编号)
        L.SubItems(3) = CStr(rs!卡上余额)
        L.SubItems(4) = CStr(rs!充值金额)
        L.SubItems(5) = CStr(rs!操作类型)
        L.SubItems(6) = CStr(rs!赠送积分)
        L.SubItems(7) = CStr(rs!操作员)
        L.SubItems(8) = CStr(rs!操作时间)
        L.SubItems(9) = CStr(rs!IC卡类)
        L.SubItems(10) = Trim(" " & rs!月份)
        i = i + 1
        rs.MoveNext
Loop
rDate = Format(DTPickerf1.Value, "yyyy-mm-dd") & " 至：" & Format(DTPickerf2.Value, "yyyy-mm-dd")
maSys_db.Execute "delete from 充值汇总表"
maSys_db.Execute "insert into 充值汇总表(售卡数量,充值金额,充正金额,充次次数,减次次数,退卡数量,退卡金额,累计金额,数据日期)" _
                            & "values(" & rSellCount & "," & rSellMoney & "," & rpMoney & "," _
                            & rSellTimes & "," & rpTimes & "," & rTurnCount & "," & rTurnMoney & "," _
                            & rSellMoney - rpMoney + rTurnMoney & ",'" & rDate & "')"

End Sub

Private Sub Option3_Click()
Call Option4_Click
End Sub

Private Sub Option4_Click()
ListViewxf.ListItems.Clear
If Option3.Value = True Then
    FrameF.Visible = True
    FrameR.Visible = False
    DTPickerf1 = Format(Now, "yyyy-mm-dd")
    DTPickerf2 = Format(Now, "yyyy-mm-dd")
    Call sGetCardtype
    Call sGetDotype
Else
    FrameF.Visible = False
    FrameR.Visible = True
    DTPickerr1 = Format(Now, "yyyy-mm-dd")
    DTPickerr2 = Format(Now, "yyyy-mm-dd")
    Call sGetBm
    Call sGetCardtype
End If
End Sub

Private Sub txtEmpID_KeyPress(KeyAscii As Integer)
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
        KeyAscii = 0
End If
End Sub

Private Sub txtEmpID_LostFocus()
txtEmpID = Format(txtEmpID, "00000000")
End Sub

Private Sub txtxfLS_KeyPress(KeyAscii As Integer)
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
        KeyAscii = 0
End If
End Sub