frmstat.frm

主要功能如题

VERSION 5.00
Begin VB.Form frmStat 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "用户分析"
   ClientHeight    =   6795
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9885
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmStat.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6795
   ScaleWidth      =   9885
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdQuit 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   7560
      TabIndex        =   1
      Top             =   6345
      Width           =   1230
   End
   Begin VB.PictureBox Gridbrowser 
      BackColor       =   &H80000005&
      FillStyle       =   0  'Solid
      ForeColor       =   &H80000008&
      Height          =   6225
      Left            =   0
      ScaleHeight     =   6165
      ScaleWidth      =   9825
      TabIndex        =   0
      Top             =   0
      Width           =   9885
   End
End
Attribute VB_Name = "frmStat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :用户分析（统计）
'*    功 能 描 述 :
'*    程序员姓名  :谭怀志
'*    最后修改人  :谭怀志
'*    最后修改时间:2003/6/26
'*    备        注:
'*******************************************************

Private m_StartDate As Date
Private m_EndDate As Date
Private m_SType As Integer

'统计分析的开始日期
Public Property Let StartDate(ByVal NewValue As Date)

     m_StartDate = NewValue
     
End Property

'统计分析的开始日期
Public Property Let EndDate(ByVal NewValue As Date)

    m_EndDate = NewValue
    
End Property

'统计分析的用户类型
Public Property Let SType(ByVal NewValue As Integer)

    m_SType = NewValue

End Property

Private Sub cmdQuit_Click()

    Unload Me

End Sub

Private Sub Form_Resize()
    
    On Error GoTo VBError
    
    '初始化网格
    With Gridbrowser
     
        .RowHeight(0) = 350
        .ColAlignment(0) = flexAlignLeftCenter
        .Cols = 8
        .FixedRows = 1
        .SelectionMode = flexSelectionByRow
        .AllowUserResizing = flexResizeColumns
        .ExplorerBar = flexExSort
        
        .ColWidth(0) = 1000
        .ColWidth(1) = 1800
        .ColWidth(2) = 1000
        .ColWidth(3) = 1200
        .ColWidth(4) = 1200
        .ColWidth(5) = 1200
        .ColWidth(6) = 1200
        .ColWidth(7) = 1200
        
        .TextMatrix(0, 0) = "用户ID"
        .TextMatrix(0, 1) = "用户名称"
        .TextMatrix(0, 2) = "当前余额"
        .TextMatrix(0, 3) = "本期消费金额"
        .TextMatrix(0, 4) = "已消费总金额"
        .TextMatrix(0, 5) = "本期发送条数"
        .TextMatrix(0, 6) = "已发送总条数"
        .TextMatrix(0, 7) = "可发送条数"
    
        .Rows = .FixedRows
        
        '统计用户计费数据
        Call UserStat
        
    End With
    
    Exit Sub
    
VBError:
    DisplayVBError

End Sub

Private Sub UserStat()

    On Error GoTo ADOError

    Dim tmprstCustomers As ADODB.Recordset
    
    With Gridbrowser
        .Rows = .FixedRows
        .Redraw = False
    End With
    
    Select Case m_SType
    Case 0  '所有用户
        strQry = "select UserID,Tmoney=SUM(Money),TotalNum=COUNT(UserID) from JFparti  where SendTime>='" & m_StartDate & "' and SendTime<'" & m_EndDate + 1 & "' group by UserID"
    Case 1  '单条用户
        strQry = "select UserID,Tmoney=SUM(Money),TotalNum=COUNT(UserID) from JFparti where SendTime>='" & m_StartDate & "' and SendTime<'" & m_EndDate + 1 & "' and JFtype=0 group by UserID"
    Case 2  '包月用户
        strQry = "select UserID,Tmoney=SUM(Money),TotalNum=COUNT(UserID) from JFparti where SendTime>='" & m_StartDate & "' and SendTime<'" & m_EndDate + 1 & "' and JFtype=1 group by UserID"
    End Select
    
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    
    While Not rstCustomers.EOF
    
        strQry = "select FirstName,LastName,SendFlag,Cmoney,SendedNum,TotalMoney,SendableNum from MsgJF,sysUser where MsgJF.UserID='" & rstCustomers!UserID & "' and  MsgJF.UserID=sysUser.UserID"
        Set tmprstCustomers = GetRecordSet(cnnConnection, strQry)
        
        With Gridbrowser
        
            .AddItem ""
            .RowHeight(.Rows - 1) = 350
            .TextMatrix(.Rows - 1, 0) = rstCustomers!UserID
            .TextMatrix(.Rows - 1, 1) = IIf(IsNull(tmprstCustomers!FirstName & tmprstCustomers!LastName), "", tmprstCustomers!FirstName & tmprstCustomers!LastName)
            .TextMatrix(.Rows - 1, 2) = Format(tmprstCustomers!Cmoney, "########0.00")
            .TextMatrix(.Rows - 1, 3) = Format(rstCustomers!Tmoney, "########0.00")
            .TextMatrix(.Rows - 1, 4) = Format(tmprstCustomers!TotalMoney, "########0.00")
            .TextMatrix(.Rows - 1, 5) = rstCustomers!TotalNum
            .TextMatrix(.Rows - 1, 6) = tmprstCustomers!SendedNum
            .TextMatrix(.Rows - 1, 7) = IIf(tmprstCustomers!SendableNum = -1, "无限制", tmprstCustomers!SendableNum)
            
        End With
        
        rstCustomers.MoveNext
        
    Wend
    
    Gridbrowser.Redraw = True
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection

End Sub