frmclassq.frm

北大青鸟教学管理系统是学习规范编程范本.功能非常完备,代码编写有章法,不可多得

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmClassQ 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "班级信息查询"
   ClientHeight    =   4740
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8295
   Icon            =   "frmClassQ.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4740
   ScaleWidth      =   8295
   Begin VB.Frame fraClassInfo 
      Caption         =   "班级详细信息"
      Height          =   2415
      Left            =   120
      TabIndex        =   7
      Top             =   2160
      Width           =   6615
      Begin VB.TextBox txtClassNo 
         Enabled         =   0   'False
         Height          =   375
         Left            =   1200
         TabIndex        =   11
         Top             =   240
         Width           =   1815
      End
      Begin VB.TextBox txtBegDate 
         BeginProperty DataFormat 
            Type            =   1
            Format          =   "yyyy-M-d"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   3
         EndProperty
         Enabled         =   0   'False
         Height          =   375
         Left            =   1200
         TabIndex        =   10
         Top             =   720
         Width           =   1815
      End
      Begin VB.TextBox txtEndDate 
         BeginProperty DataFormat 
            Type            =   1
            Format          =   "yyyy-M-d"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   3
         EndProperty
         Enabled         =   0   'False
         Height          =   375
         Left            =   4560
         TabIndex        =   9
         Top             =   720
         Width           =   1815
      End
      Begin VB.TextBox txtRemark 
         Enabled         =   0   'False
         Height          =   855
         Left            =   240
         TabIndex        =   8
         Top             =   1440
         Width           =   6135
      End
      Begin VB.Label Label1 
         Caption         =   "班级编号："
         Height          =   255
         Left            =   240
         TabIndex        =   15
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "开班日期："
         Height          =   375
         Left            =   240
         TabIndex        =   14
         Top             =   840
         Width           =   1095
      End
      Begin VB.Label Label3 
         Caption         =   "结束日期："
         Height          =   255
         Left            =   3360
         TabIndex        =   13
         Top             =   840
         Width           =   975
      End
      Begin VB.Label Label4 
         Caption         =   "备注："
         Height          =   255
         Left            =   240
         TabIndex        =   12
         Top             =   1200
         Width           =   735
      End
   End
   Begin VB.CommandButton cmdLast 
      Caption         =   "最后一条"
      Height          =   350
      Left            =   6840
      TabIndex        =   5
      Top             =   3360
      Width           =   1335
   End
   Begin VB.CommandButton cmdDown 
      Caption         =   "后一条"
      Height          =   350
      Left            =   6840
      TabIndex        =   4
      Top             =   3000
      Width           =   1335
   End
   Begin VB.CommandButton cmdUp 
      Caption         =   "前一条"
      Height          =   350
      Left            =   6840
      TabIndex        =   3
      Top             =   2640
      Width           =   1335
   End
   Begin VB.CommandButton cmdFirst 
      Caption         =   "最前一条"
      Height          =   350
      Left            =   6840
      TabIndex        =   2
      Top             =   2280
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "关闭(&C)"
      Height          =   370
      Left            =   6840
      TabIndex        =   1
      Top             =   4200
      Width           =   1335
   End
   Begin VB.CommandButton cmdRetrieve 
      Caption         =   "检索班级"
      Height          =   370
      Left            =   6840
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
   Begin MSFlexGridLib.MSFlexGrid MsflxClass 
      Height          =   1935
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   6615
      _ExtentX        =   11668
      _ExtentY        =   3413
      _Version        =   393216
      Rows            =   3
      Cols            =   5
      FixedRows       =   2
      FocusRect       =   0
      AllowUserResizing=   1
   End
End
Attribute VB_Name = "frmClassQ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdDown_Click()
    If MsflxClass.Row < MsflxClass.Rows - 1 Then
        MsflxClass.Row = MsflxClass.Row + 1
        DisplayInfo
    End If
End Sub

Private Sub cmdFirst_Click()
    MsflxClass.Row = 2
    DisplayInfo
End Sub

Private Sub cmdLast_Click()
    MsflxClass.Row = MsflxClass.Rows - 1
    DisplayInfo
End Sub

Private Sub cmdRetrieve_Click()
    Dim intIndex As Integer
On Error GoTo ErrLab

    Do While MsflxClass.Rows > 3  '以下8行为清空列表
        MsflxClass.RemoveItem MsflxClass.Rows - 1
    Loop
    MsflxClass.Row = 2
    For intIndex = 0 To 4
        MsflxClass.Col = intIndex
        MsflxClass.Text = Empty
    Next intIndex
    
    Set Rst = New ADODB.Recordset
    If Fun_Rst("classinfo") Then
        If Rst.BOF = True And Rst.EOF = True Then
            MsgBox "没有任何记录....", vbInformation + vbOKOnly, "检索记录"
        Else
            Do While Rst.EOF = False
                MsflxClass.Row = MsflxClass.Rows - 1
                MsflxClass.Col = 0
                MsflxClass.Text = MsflxClass.Rows - 2   '序号
                MsflxClass.Col = 1
                MsflxClass.Text = Rst.Fields("ClassNo")
                MsflxClass.Col = 2
                MsflxClass.Text = Rst.Fields("begdate")
                MsflxClass.Col = 3
                If Rst.Fields("enddate") <> Null Then
                    MsflxClass.Text = CStr(Rst.Fields("enddate"))
                Else
                    MsflxClass.Text = Empty
                End If
                MsflxClass.Col = 4
                If Rst.Fields("remark") <> Null Then
                    MsflxClass.Text = Rst.Filter("remark")
                Else
                    MsflxClass.Text = Empty
                End If
                Rst.MoveNext
                If Rst.EOF = False Then
                    MsflxClass.AddItem Empty
                End If
            Loop
            MsflxClass.Row = 2
            Call DisplayInfo
            MsgBox "信息检索成功....", vbInformation + vbOKOnly, "信息检索"
        End If
    Else
        MsgBox "信息检索失败....", vbCritical + vbOKOnly, "信息检索"
    End If
    Exit Sub
ErrLab:
    If Err.Number = 94 Then
        Resume Next
    Else
        MsgBox "未知错误:" & Err.Description & vbCrLf & "错误代号:" & Err.Number, vbCritical + vbOKOnly, "未知错误"
    End If
End Sub

Private Sub cmdUp_Click()
    If MsflxClass.Row > 2 Then
        MsflxClass.Row = MsflxClass.Row - 1
        DisplayInfo
    End If
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim intIndex As Integer
    MsflxClass.MergeCells = flexMergeFree
    MsflxClass.Row = 0
    MsflxClass.ColWidth(0) = 600                '设定第一列宽为600
    For intIndex = 1 To MsflxClass.Cols - 1
        MsflxClass.Col = intIndex
        MsflxClass.Text = "班级信息列表"
        MsflxClass.ColWidth(intIndex) = 1300

    Next intIndex
    MsflxClass.MergeRow(0) = True
    
    MsflxClass.Row = 1
    MsflxClass.Col = 0
    MsflxClass.Text = "序号"
    
    MsflxClass.Col = 1
    MsflxClass.Text = "班级编号"
    
    MsflxClass.Col = 2
    MsflxClass.Text = "开班日期"

    MsflxClass.Col = 3
    MsflxClass.Text = "结业日期"

    MsflxClass.Col = 4
    MsflxClass.Text = "备注"

End Sub

Private Sub MSFlxClass_Click()
    Call DisplayInfo
End Sub

Sub DisplayInfo()
    MsflxClass.Col = 1
    txtClassNo = MsflxClass.Text
    MsflxClass.Col = 2
    txtBegDate = MsflxClass.Text
    MsflxClass.Col = 3
    txtEndDate = MsflxClass.Text
    MsflxClass.Col = 4
    txtRemark = MsflxClass.Text
        
    Dim intCol As Integer
    Dim intRow As Integer
    Dim TmpRow As Integer
    TmpRow = MsflxClass.Row
    For intRow = 2 To MsflxClass.Rows - 1
        MsflxClass.Row = intRow
        If TmpRow = intRow Then
            For intCol = 1 To MsflxClass.Cols - 1
                MsflxClass.Col = intCol
                MsflxClass.CellForeColor = vbYellow
                MsflxClass.CellBackColor = &H8000000D
            Next intCol
        Else
            For intCol = 1 To MsflxClass.Cols - 1
                MsflxClass.Col = intCol
                MsflxClass.CellBackColor = vbWhite
                MsflxClass.CellForeColor = vbBlack
            Next intCol
        End If
    Next intRow
    MsflxClass.Row = TmpRow
End Sub

Private Sub txtBegDate_LostFocus()
On Error GoTo Err_Date
    If txtBegDate <> Empty Then
        txtBegDate = CDate(txtBegDate)
    End If
    Exit Sub
Err_Date:
    MsgBox "日期格式错误", vbCritical + vbOKOnly, "错误"
    txtBegDate = Empty
End Sub

Private Sub txtEndDate_LostFocus()
On Error GoTo Err_Date
    If txtBegDate <> Empty Then
        txtBegDate = CDate(txtBegDate)
    End If
    Exit Sub
Err_Date:
    MsgBox "日期格式错误", vbCritical + vbOKOnly, "错误"
    txtBegDate = Empty
End Sub