frmerrrep.frm

由VB编写的一个实用短信计费系统。主要模块包括（1）计费管理子系统：用户入费；错单处理；用户费率管理；费率管理；用户分析（2）系统维护子系统：管理员登录、管理员管理、数据库设置等（3）计费引擎子系统

      AllowSelection  =   -1  'True
      AllowBigSelection=   -1  'True
      AllowUserResizing=   0
      SelectionMode   =   1
      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 = "frmErrRep"
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
     
        .ColAlignment(0) = flexAlignLeftCenter
        .Cols = 13
        .FixedRows = 1
        .SelectionMode = flexSelectionByRow
        .AllowUserResizing = flexResizeColumns
        .ExplorerBar = flexExSort
        
        .ColWidth(0) = 1500
        .ColWidth(1) = 1000
        .ColWidth(2) = 2000
        .ColWidth(3) = 1000
        .ColWidth(4) = 1000
        .ColWidth(5) = 1200
        .ColWidth(6) = 1000
        .ColWidth(7) = 1000
        
        .RowHeight(0) = 350
        .TextMatrix(0, 0) = "入费单ID"
        .TextMatrix(0, 1) = "用户ID"
        .TextMatrix(0, 2) = "用户名称"
        .TextMatrix(0, 3) = "入费金额"
        .TextMatrix(0, 4) = "入费时间"
        .TextMatrix(0, 5) = "费率"
        .TextMatrix(0, 6) = "开始日期"
        .TextMatrix(0, 7) = "结束日期"
        .TextMatrix(0, 8) = ""
        .TextMatrix(0, 9) = ""
        .TextMatrix(0, 10) = "状态"
        .TextMatrix(0, 11) = ""
        .TextMatrix(0, 12) = ""

        .ColAlignment(8) = 0
        .ColHidden(9) = True
        .ColHidden(8) = True
        .ColHidden(11) = True
        .ColHidden(12) = True
        
        '列出所有入费单
        Call RFDrefresh
        
    End With

End Sub



Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)

    On Error GoTo VBError

    Select Case Button.Key
    Case "error"    '错单重单处理
    
        If Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) <> "" And Gridbrowser.RowSel > 0 Then
        
            Load frmErrTable
            
            With Gridbrowser
            
                '错单的计费方式
                frmErrTable.FLtype = Val(.TextMatrix(.RowSel, 8))
                
                '更正单的计费方式
                frmErrTable.SelectFLtype = Val(.TextMatrix(.RowSel, 8))
                
                frmErrTable!txtTableID(0).Text = .TextMatrix(.RowSel, 0)
                frmErrTable!txtTableID(1).Text = .TextMatrix(.RowSel, 0)
                frmErrTable!dtpDate(0).Value = .TextMatrix(.RowSel, 4)
                frmErrTable!dtpDate(1).Value = .TextMatrix(.RowSel, 4)
                frmErrTable!txtFL(0).Text = .TextMatrix(.RowSel, 5)
                frmErrTable!txtFL(1).Text = .TextMatrix(.RowSel, 5)
                
                frmErrTable.SelectUid = .TextMatrix(.RowSel, 1)
                frmErrTable.JFunit = Val(.TextMatrix(.RowSel, 12))
                frmErrTable.JFquan = Val(.TextMatrix(.RowSel, 11))
                
                If Val(.TextMatrix(.RowSel, 8)) = 1 Then
                    frmErrTable!dtpStart(0).Value = .TextMatrix(.RowSel, 6)
                    frmErrTable!dtpStart(1).Value = .TextMatrix(.RowSel, 6)
                    frmErrTable!dtpEnd(0).Value = .TextMatrix(.RowSel, 7)
                    frmErrTable!dtpEnd(1).Value = .TextMatrix(.RowSel, 7)
                End If
                
                frmErrTable!txtUserID(0).Text = .TextMatrix(.RowSel, 1)
                frmErrTable!txtUserID(0).Text = .TextMatrix(.RowSel, 1)
                frmErrTable!txtUserID(1).Text = .TextMatrix(.RowSel, 1)
                frmErrTable!txtUserID(1).Text = .TextMatrix(.RowSel, 1)
                frmErrTable!txtUserName(0).Text = .TextMatrix(.RowSel, 2)
                frmErrTable!txtUserName(0).Text = .TextMatrix(.RowSel, 2)
                frmErrTable!txtUserName(1).Text = .TextMatrix(.RowSel, 2)
                frmErrTable!txtUserName(1).Text = .TextMatrix(.RowSel, 2)
                
                
                frmErrTable!txtCmoney(0).Text = .TextMatrix(.RowSel, 9)
                frmErrTable!txtCmoney(1).Text = .TextMatrix(.RowSel, 9)
                frmErrTable!txtNmoney(0).Text = .TextMatrix(.RowSel, 3)
                frmErrTable!txtNmoney(1).Text = .TextMatrix(.RowSel, 3)
                
                frmErrTable!chkDel.Value = IIf(.TextMatrix(.RowSel, 10) = "", 0, 1)
                frmErrTable.RFDstatus = IIf(.TextMatrix(.RowSel, 10) = "", 0, 1)
                
                frmErrTable.Show vbModal
                
            End With
        
        End If
        
    Case "query"    '按指定条件查询入费单
        
        frmQueryIntable.Show vbModal
        
    Case "all"      '列出所有入费单
    
        Call RFDrefresh
        
    Case "recordset"    '查看入费单操作记录
    
        frmRecordset.Show vbModal
    
    Case "close"
    
        Unload Me
        
    End Select
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub

Private Sub RFDrefresh()
    
    '显示所有的入费单
    With Gridbrowser
        .Rows = .FixedRows
        .Rows = .FixedRows
        .Redraw = False
        
        On Error GoTo ADOError
        
        strQry = "select ID,RFDconf.UserID,FirstName,LastName,RFdate,Money,RFDconf.FLname,RFDconf.StartDate,RFDconf.EndDate,RFDconf.JFtype, Cmoney,RFDconf.Status,JFsetting.FLid,JFquan,JFunit from RFDconf,sysUser,JFsetting,FLlist,MsgJF where RFDconf.UserID=sysUser.UserID and RFDconf.UserID=JFsetting.UserID and RFDconf.UserID=MsgJF.UserID and JFsetting.FLid=FLlist.FLid"
        Set rstCustomers = GetRecordSet(cnnConnection, strQry)
        
        While Not rstCustomers.EOF
        
            .AddItem ""
            .RowHeight(.Rows - 1) = 350
            .TextMatrix(.Rows - 1, 0) = rstCustomers!ID
            .TextMatrix(.Rows - 1, 1) = rstCustomers!UserID
            .TextMatrix(.Rows - 1, 2) = IIf(IsNull(rstCustomers!FirstName & rstCustomers!LastName), "", rstCustomers!FirstName & rstCustomers!LastName)
            .TextMatrix(.Rows - 1, 3) = Format(rstCustomers!Money, "########0.00")
            .TextMatrix(.Rows - 1, 4) = rstCustomers!RFdate
            .TextMatrix(.Rows - 1, 5) = rstCustomers!FLname
            .TextMatrix(.Rows - 1, 8) = rstCustomers!JFtype
            .TextMatrix(.Rows - 1, 6) = IIf(IsNull(rstCustomers!StartDate), "", rstCustomers!StartDate)
            .TextMatrix(.Rows - 1, 7) = IIf(IsNull(rstCustomers!EndDate), "", rstCustomers!EndDate)
            .TextMatrix(.Rows - 1, 9) = Format(rstCustomers!Cmoney, "########0.00")
            .TextMatrix(.Rows - 1, 10) = IIf(rstCustomers!Status = 1, "无效单", "")
            .TextMatrix(.Rows - 1, 11) = rstCustomers!JFquan
            .TextMatrix(.Rows - 1, 12) = rstCustomers!JFunit
            rstCustomers.MoveNext
            
        Wend
        
        .Redraw = True
        
    End With
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub