frmincharge.frm

这是一个Web短信平台后台部分中的预付费管理系统,采用SQL Server数据库,主要是对短信服务的注册用户进得后台充值预付费管理。用到了第三方控件 VideoSoft Active Controls

      FocusRect       =   1
      HighLight       =   1
      AllowSelection  =   -1  'True
      AllowBigSelection=   -1  'True
      AllowUserResizing=   0
      SelectionMode   =   0
      GridLines       =   1
      GridLinesFixed  =   2
      GridLineWidth   =   1
      Rows            =   5000
      Cols            =   10
      FixedRows       =   1
      FixedCols       =   0
      RowHeightMin    =   0
      RowHeightMax    =   0
      ColWidthMin     =   0
      ColWidthMax     =   0
      ExtendLastCol   =   0   'False
      FormatString    =   ""
      ScrollTrack     =   0   'False
      ScrollBars      =   3
      ScrollTips      =   0   'False
      MergeCells      =   0
      MergeCompare    =   0
      AutoResize      =   -1  'True
      AutoSizeMode    =   0
      AutoSearch      =   0
      MultiTotals     =   -1  'True
      SubtotalPosition=   1
      OutlineBar      =   0
      OutlineCol      =   0
      Ellipsis        =   0
      ExplorerBar     =   0
      PicturesOver    =   0   'False
      FillStyle       =   0
      RightToLeft     =   0   'False
      PictureType     =   0
      TabBehavior     =   0
      OwnerDraw       =   0
      Editable        =   0   'False
      ShowComboButton =   -1  'True
      WordWrap        =   0   'False
      TextStyle       =   0
      TextStyleFixed  =   0
      OleDragMode     =   0
      OleDropMode     =   0
      DataMode        =   0
      VirtualData     =   -1  'True
   End
End
Attribute VB_Name = "frmIncharge"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :用户入费
'*    功 能 描 述 :
'*    程序员姓名  :谭怀志
'*    最后修改人  :谭怀志
'*    最后修改时间:2003/6/26
'*    备        注:
'*******************************************************

Private Sub Form_Load()
    
    '初始化网格
    With Gridbrowser
     
        .RowHeight(0) = 350
        .ColAlignment(0) = flexAlignLeftCenter
        .Cols = 7
        .FixedRows = 1
        .SelectionMode = flexSelectionByRow
        .AllowUserResizing = flexResizeColumns
        .ExplorerBar = flexExSort
        
        .ColWidth(0) = 1000
        .ColWidth(1) = 1800
        .ColWidth(2) = 1000
        .ColWidth(3) = 1000
        .ColWidth(4) = 2500
        .ColWidth(5) = 1200
        .ColWidth(6) = 2000
        
        .TextMatrix(0, 0) = "用户ID"
        .TextMatrix(0, 1) = "用户名称"
        .TextMatrix(0, 2) = "当前余额"
        .TextMatrix(0, 3) = "状态"
        .TextMatrix(0, 4) = "地址"
        .TextMatrix(0, 5) = "联系电话"
        .TextMatrix(0, 6) = "电子邮箱"

        .Rows = .FixedRows
        
        '列出所有用户
        Call UserRefresh
        
    End With
    
   
    
End Sub

'列出所有用户
Private Sub UserRefresh()

    On Error GoTo ADOError
    
    With Gridbrowser
        .Rows = .FixedRows
        .Redraw = False
    End With

    strQry = "select sysUser.UserID,FirstName,LastName,Addr,Phone,Email,Cmoney,SendFlag from sysUser,MsgJF where sysUser.UserID=MsgJF.UserID"
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    
    While Not rstCustomers.EOF
    
        Gridbrowser.AddItem ""
        
        With Gridbrowser
        
            .RowHeight(.Rows - 1) = 350
            .TextMatrix(.Rows - 1, 0) = rstCustomers!UserID
            .TextMatrix(.Rows - 1, 1) = IIf(IsNull(rstCustomers!FirstName & rstCustomers!LastName), "", rstCustomers!FirstName & rstCustomers!LastName)
            .TextMatrix(.Rows - 1, 2) = Format(rstCustomers!Cmoney, "########0.00")
            .TextMatrix(.Rows - 1, 3) = IIf(rstCustomers!SendFlag = 0, "可发送", "不可发送")
            .TextMatrix(.Rows - 1, 4) = IIf(IsNull(rstCustomers!Addr), "", rstCustomers!Addr)
            .TextMatrix(.Rows - 1, 5) = IIf(IsNull(rstCustomers!Phone), "", rstCustomers!Phone)
            .TextMatrix(.Rows - 1, 6) = IIf(IsNull(rstCustomers!Email), "", rstCustomers!Email)
            
        End With
    
        rstCustomers.MoveNext
        
    Wend
    
    Gridbrowser.Redraw = True
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
    Case "add"      '用户入费
    
        On Error GoTo ADOError
        
        If Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) <> "" And Gridbrowser.RowSel > 0 Then
            
            strQry = "select FLname,FLid,JFtype,JFunit,JFquan from FLlist where FLid=(select FLid from JFsetting where UserID='" & Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) & "')"
            Set rstCustomers = GetRecordSet(cnnConnection, strQry)
            
            If rstCustomers.RecordCount <> 0 Then
            
                Load frmInTable
                frmInTable!txtFL.Text = rstCustomers!FLname
                frmInTable.FLtype = rstCustomers!JFtype
                frmInTable.FLid = rstCustomers!FLid
                
                If rstCustomers!JFtype = 1 Then
                    frmInTable!txtNmoney.Text = Format(rstCustomers!JFquan, "########0.00")
                Else
                    frmInTable!txtNmoney.Text = ""
                End If
                
            Else
            
                MsgBox "该用户没有设置费率！", vbCritical, ERRCAPTION
                Exit Sub
                
            End If
            
            With Gridbrowser
            
                frmInTable!txtUserID.Text = .TextMatrix(.RowSel, 0)
                frmInTable!txtUserName.Text = .TextMatrix(.RowSel, 1)
                frmInTable!txtCmoney.Text = Format(Val(.TextMatrix(.RowSel, 2)), "########0.00")
            
            End With
            
            frmInTable.Show vbModal
            
        End If
        
    Case "query"    '查询指定用户
    
        frmQueryInCharge.Show vbModal
        
    Case "all"      '列出所有用户
    
        Call UserRefresh
        
    Case "refresh"  '刷新所选用户的状态
        
        If Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) <> "" And Gridbrowser.RowSel > 0 Then
        
            SingleRefresh
            
        End If
        
    Case "close"
    
        Unload Me
    
    End Select
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub

'刷新单个用户的状态
Private Sub SingleRefresh()

    On Error GoTo ADOError

    strQry = "select Cmoney,SendFlag from MsgJF where UserID='" & Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) & "'"
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
                    
    With Gridbrowser
                
        .RowHeight(.RowSel) = 350
        .TextMatrix(.RowSel, 2) = Format(rstCustomers!Cmoney, "########0.00")
        .TextMatrix(.RowSel, 3) = IIf(rstCustomers!SendFlag = 0, "可发送", "不可发送")
                    
    End With
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub