frmrate.frm

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

      EndProperty
      MousePointer    =   0
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      BackColorFixed  =   -2147483633
      ForeColorFixed  =   -2147483630
      BackColorSel    =   -2147483635
      ForeColorSel    =   -2147483634
      BackColorBkg    =   8421504
      BackColorAlternate=   -2147483643
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483632
      TreeColor       =   -2147483632
      FloodColor      =   192
      SheetBorder     =   -2147483642
      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 = "frmRate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :计费费率管理
'*    功 能 描 述 :
'*    程序员姓名  :谭怀志
'*    最后修改人  :谭怀志
'*    最后修改时间:2003/6/26
'*    备        注:
'*******************************************************

Private Sub Form_Load()
    
    On Error GoTo VBError
    
    '初始化网格
    With Gridbrowser
     
        .RowHeight(0) = 350
        .ColAlignment(0) = flexAlignLeftCenter
        .Cols = 6
        .FixedRows = 1
        .SelectionMode = flexSelectionListBox
        .AllowUserResizing = flexResizeColumns
        .ExplorerBar = flexExSort
        
        .ColWidth(0) = 800
        .ColWidth(1) = 1500
        .ColWidth(2) = 1200
        .ColWidth(3) = 1200
        .ColWidth(4) = 1200
        
        .TextMatrix(0, 0) = "ID"
        .TextMatrix(0, 1) = "费率名称"
        .TextMatrix(0, 2) = "计费单位"
        .TextMatrix(0, 3) = "费额"
        .TextMatrix(0, 4) = "状态"
        .TextMatrix(0, 5) = ""
        
        .ColHidden(5) = True
        .Rows = .FixedRows
        .Redraw = False
        
        On Error GoTo ADOError
        
        '列出所有费率
        strQry = "Select * from FLlist"
        Set rstCustomers = GetRecordSet(cnnConnection, strQry)
        
        While Not rstCustomers.EOF
            
            With Gridbrowser
            
                .AddItem ""
                .RowHeight(Rows - 1) = 350
                .TextMatrix(.Rows - 1, 0) = rstCustomers!FLid
                .TextMatrix(.Rows - 1, 1) = rstCustomers!FLname
                .TextMatrix(.Rows - 1, 2) = rstCustomers!JFunit
                .TextMatrix(.Rows - 1, 3) = Format(rstCustomers!JFquan, "########0.00")
                .TextMatrix(.Rows - 1, 4) = IIf(rstCustomers!Status = 1, "默认费率", "")
                .TextMatrix(.Rows - 1, 5) = Trim(Str(rstCustomers!JFtype))
                
            End With
            
            rstCustomers.MoveNext
            
        Wend
        
        .Redraw = True
        
    End With
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)

    On Error GoTo VBError
    
    Select Case Button.Key
    Case "add"      '新增费率
    
        Load frmFLedit
        frmFLedit.WhichFunction = "New"
            
        frmFLedit.Show vbModal
            
    Case "modify"   '修改费率
            
        With Gridbrowser
            
            If .TextMatrix(.RowSel, 0) <> "" And .RowSel > 0 Then
                Load frmFLedit
                frmFLedit!txtFLid.Text = .TextMatrix(.RowSel, 0)
                frmFLedit!cboJFtype.ListIndex = Val(.TextMatrix(.RowSel, 5))
                frmFLedit!txtQuan.Text = .TextMatrix(.RowSel, 3)
                frmFLedit!txtFLname.Text = .TextMatrix(.RowSel, 1)
                frmFLedit.WhichFunction = "Modify"
                frmFLedit.Show vbModal
            End If
                
        End With
            
    Case "del"      '删除费率
    
        If Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) = "" And Gridbrowser.RowSel < 1 Then
            Exit Sub
        End If
            
        If MsgBox("确定删除所选的费率吗？", vbOKCancel + vbDefaultButton2, systemcaption) = vbNo Then
            Exit Sub
        End If
                
        For i = Gridbrowser.Rows - 1 To 1 Step -1
                    
            If Gridbrowser.IsSelected(i) Then
                        
                On Error GoTo ADOError
                            
                strQry = "select UserID from JFsetting where FLid=" & Gridbrowser.TextMatrix(i, 0)
                Set rstCustomers = GetRecordSet(cnnConnection, strQry)
                                
                If rstCustomers.RecordCount <> 0 Then
                
                    '正在使用的费率不能删除
                    MsgBox "费率 “" & Gridbrowser.TextMatrix(i, 1) & "” 正在使用，不能删除！", vbInformation, TIPCAPTION
                Else
                    cnnConnection.Execute ("delete from FLlist where FLid=" & Gridbrowser.TextMatrix(i, 0))
                    Gridbrowser.RemoveItem i
                End If
                            
            End If
                        
        Next i
        
    Case "close"
        
            Unload Me
        
    End Select
        
    Exit Sub
        
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
         
End Sub