frmdatagrid.frm

教务管理系统,用VB 完成,以SQL SERVER 2000作为后台数据库

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmDataGrid 
   BackColor       =   &H00C0C0C0&
   Caption         =   "成绩库全屏浏览"
   ClientHeight    =   6795
   ClientLeft      =   1650
   ClientTop       =   1545
   ClientWidth     =   9480
   Icon            =   "frmDataGrid.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   6795
   ScaleMode       =   0  'User
   ScaleWidth      =   9480
   StartUpPosition =   2  'CenterScreen
   Begin MSFlexGridLib.MSFlexGrid GrdDATAGRID 
      Bindings        =   "frmDataGrid.frx":030A
      Height          =   6015
      Left            =   30
      TabIndex        =   6
      Top             =   360
      Width           =   9375
      _ExtentX        =   16536
      _ExtentY        =   10610
      _Version        =   327680
      FixedCols       =   0
      AllowUserResizing=   3
   End
   Begin ComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   5
      Top             =   6420
      Width           =   9480
      _ExtentX        =   16722
      _ExtentY        =   661
      SimpleText      =   ""
      _Version        =   327682
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
         NumPanels       =   3
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            Style           =   6
            Alignment       =   1
            AutoSize        =   2
            TextSave        =   "1998-09-28"
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            Style           =   5
            Alignment       =   1
            AutoSize        =   2
            TextSave        =   "22:55"
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            AutoSize        =   1
            Object.Width           =   11033
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.PictureBox picButtons 
      Align           =   1  'Align Top
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   330
      Left            =   0
      ScaleHeight     =   330
      ScaleWidth      =   9480
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   9480
      Begin VB.CommandButton cmdClose 
         Caption         =   "关闭(&C)"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   330
         Left            =   4398
         TabIndex        =   4
         Tag             =   "&Close"
         Top             =   0
         Width           =   1437
      End
      Begin VB.CommandButton cmdFilter 
         Caption         =   "过滤器(&F)"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   330
         Left            =   2924
         TabIndex        =   3
         Tag             =   "&Filter"
         Top             =   0
         Width           =   1462
      End
      Begin VB.CommandButton cmdSort 
         Caption         =   "排序(&S)"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   330
         Left            =   1462
         TabIndex        =   2
         Tag             =   "&Sort"
         Top             =   0
         Width           =   1462
      End
      Begin VB.CommandButton cmdRefresh 
         Caption         =   "刷新(&R)"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   330
         Left            =   0
         TabIndex        =   1
         Tag             =   "&Refresh"
         Top             =   0
         Width           =   1462
      End
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   3150
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   6240
      Visible         =   0   'False
      Width           =   1140
   End
End
Attribute VB_Name = "frmDataGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim msSortCol As String
Dim mbCtrlKey As Integer
Dim SortStr As String
Sub cmdClose_Click()
   FRMKCDW_ID = True
    If Data1.Recordset.BOF And Data1.Recordset.EOF Then Unload Me: Exit Sub
    Data1.Recordset.MoveFirst
    'Data1.Recordset.Close
    Unload Me
End Sub

Private Sub cmdFilter_Click()
    On Error GoTo FilterErr

    Dim recRecordset1 As Recordset, recRecordset2 As Recordset
    Dim sFilterStr As String

    If Data1.RecordsetType = vbRSTypeTable Then
        Beep
        MsgBox "不能过滤表记录集！", 48
        Exit Sub
    End If
    
    Set recRecordset1 = Data1.Recordset                        '复制记录集
    
    sFilterStr = InputBox("输入过滤器表达式(如:课程名称='高等数学')：")
    If Len(sFilterStr) = 0 Then Exit Sub

    'Screen.MousePointer = vbHourglass
    recRecordset1.Filter = sFilterStr
    Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type) '建立过滤器
    Set Data1.Recordset = recRecordset2                        '赋值为初始记录集对象
    RED
    Screen.MousePointer = vbDefault
    Exit Sub

FilterErr:
    Screen.MousePointer = vbDefault
    MsgBox "错误：" & err & "，" & err.Description
End Sub

Private Sub cmdRefresh_Click()
    On Error GoTo RefErr
    
    Data1.Recordset.Requery
    RED
    Exit Sub
    
RefErr:
    MsgBox "错误：" & err & "，" & err.Description
End Sub


Private Sub cmdSort_Click()
    On Error GoTo sorterr

    Dim recRecordset1 As Recordset, recRecordset2 As Recordset
    

    If Data1.RecordsetType = vbRSTypeTable Then
        Beep
        MsgBox "不能对表记录集排序！", 48
        Exit Sub
    End If

    Set recRecordset1 = Data1.Recordset                        '复制记录集
    
    If Len(msSortCol) = 0 Then
        SortStr = InputBox("输入排序的列名(不用任何标点符号)：")
        If Len(SortStr) = 0 Then Exit Sub
    Else
        SortStr = msSortCol
    End If
    
    'Screen.MousePointer = vbHourglass
    recRecordset1.sort = SortStr
    
    '建立排序
    Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type)
    Set Data1.Recordset = recRecordset2
    RESET
    RED
    Screen.MousePointer = vbDefault
    Exit Sub

sorterr:
    Screen.MousePointer = vbDefault
    MsgBox "错误：" & err & "，" & err.Description
End Sub


Private Sub Form_Activate()
'Label1.Visible = True

Dim I As Integer
    For I = 0 To Data1.Recordset.Fields.Count - 1
    GrdDATAGRID.ColWidth(I) = 1100
    Next I
    If Data1.Recordset.BOF And Data1.Recordset.EOF Then Exit Sub
    RED
    StatusBar1.Panels.Item(3).Text = "表中共有" & Data1.Recordset.RecordCount & "条记录!"
End Sub

Private Sub Form_Load()
    Dim bParmQry As Integer
    Dim qdfTmp As QueryDef
    
    On Error GoTo LoadErr

    '要做的事情：
    'gsDatabase 是一个全局字符串，
    '它需要在启动子过程中为应用程序设置好。
    'Data1.DatabaseName = GSDATABASE
    'gsRecordSource 是一个全局字符串，
    '它需要在加载此窗体的子过程中设置好。
    'Data1.RecordSource = GSRECORDSOURCE
    Data1.RecordsetType = 1     '动态集
    Data1.Options = 0
    Data1.Refresh
    
    Exit Sub

LoadErr:
    MsgBox "错误：" & err & "，" & err.Description
    Unload Me
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.WindowState <> 1 Then
        GrdDATAGRID.Height = Me.Height - (425 + picButtons.Height + StatusBar1.Height)
        GrdDATAGRID.Width = Me.Width - 150
    End If
End Sub

Private Sub grdDataGrid_BeforeDelete(Cancel As Integer)
    If MsgBox("删除当前行吗？", vbYesNo + vbQuestion) <> vbYes Then
        Cancel = True
    End If
End Sub

Private Sub grdDataGrid_BeforeUpdate(Cancel As Integer)
    If MsgBox("提交改变吗？", vbYesNo + vbQuestion) <> vbYes Then
        Cancel = True
    End If
End Sub

'Private Sub grdDataGrid_HeadClick(ByVal ColIndex As Integer)
'    '按该列排序
'    If Data1.RecordsetType = vbRSTypeTable Then Exit Sub
'
'    '检查是否使用了用于降序排序的 ctrl 键
'    If mbCtrlKey Then
'        msSortCol = "[" & Data1.Recordset(ColIndex).Name & "] desc"
'        mbCtrlKey = 0 '复位
'    Else
'        msSortCol = "[" & Data1.Recordset(ColIndex).Name & "]"
'    End If
'    cmdSort_Click
'    msSortCol = vbNullString '复位
'    Dim I As Integer
'    For I = 0 To Data1.Recordset.Fields.Count - 1
'    GrdDATAGRID.Columns(I).Width = 1100
'    Next I
'End Sub

Private Sub grdDataGrid_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mbCtrlKey = Shift
End Sub
Private Function RED()
Dim RECDATA As Recordset
Set RECDATA = Data1.Recordset
Dim I, J As Integer
Dim NUMDATA As Long
RECDATA.MoveLast
RECDATA.MoveFirst
NUMDATA = RECDATA.Fields.Count
For I = 1 To RECDATA.RecordCount
    GrdDATAGRID.Row = I
    For J = 4 To NUMDATA - 1
    GrdDATAGRID.col = J
    If RECDATA.Fields(J).Value < 60 And RECDATA.Fields(J).Value <> 0 And Len(Trim(STR(RECDATA.Fields(J).Value))) <= 5 Then GrdDATAGRID.CellForeColor = &HFF
    If RECDATA.Fields(J).Value = 0 Then GrdDATAGRID.CellForeColor = &HFF0000
    If Len(Trim(STR(RECDATA.Fields(J).Value))) > 5 Then GrdDATAGRID.CellForeColor = &HFF00FF
    Next J
RECDATA.MoveNext
Next I

'    For I = 2 To flexResult.Rows
'        flexResult.Row = I - 1
'        flexResult.col = 5
'        flexResult.CellBackColor = &HFFFF00
'     Next I

End Function
Function RESET()
        '按该列排序
    If Data1.RecordsetType = vbRSTypeTable Then Exit Function

    '检查是否使用了用于降序排序的 ctrl 键
    If mbCtrlKey Then
        msSortCol = "[" & SortStr & "] desc"
        mbCtrlKey = 0 '复位
    Else
        msSortCol = "[" & SortStr & "] DESC" 'Data1.Recordset(ColIndex).Name & "]"
    End If
    'cmdSort_Click
    msSortCol = vbNullString
End Function