frmsearch.frm

< SQL SERVER 2000 案例教程>>,冶金工业出版社,这本书的代码

         Left            =   675
         TabIndex        =   5
         Top             =   315
         Width           =   1260
      End
      Begin MSDataListLib.DataCombo dtcmbClass 
         Bindings        =   "FrmSearch.frx":00EA
         DataField       =   "班级"
         DataMember      =   "dbo_stu_GetAllStudent"
         DataSource      =   "DataEnvironment1"
         Height          =   285
         Left            =   5520
         TabIndex        =   15
         Top             =   720
         Width           =   2295
         _ExtentX        =   4048
         _ExtentY        =   503
         _Version        =   393216
         ListField       =   "className"
         Text            =   ""
         Object.DataMember      =   "CmdClass"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   7.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Label lblFieldLabel 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "院系:"
         Height          =   180
         Index           =   6
         Left            =   5040
         TabIndex        =   13
         Top             =   405
         Width           =   450
      End
      Begin VB.Label lblFieldLabel 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "班级:"
         Height          =   255
         Index           =   5
         Left            =   4755
         TabIndex        =   12
         Top             =   780
         Width           =   735
      End
      Begin VB.Label lblFieldLabel 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "籍贯:"
         Height          =   255
         Index           =   4
         Left            =   2280
         TabIndex        =   10
         Top             =   750
         Width           =   675
      End
      Begin VB.Label lblFieldLabel 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "生日:"
         Height          =   180
         Index           =   3
         Left            =   2490
         TabIndex        =   8
         Top             =   360
         Width           =   450
      End
      Begin VB.Label lblFieldLabel 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "性别:"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   7
         Top             =   795
         Width           =   495
      End
      Begin VB.Label lblFieldLabel 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "姓名:"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   4
         Top             =   360
         Width           =   495
      End
   End
   Begin VB.CommandButton cmdSearch 
      Caption         =   "查询"
      Height          =   375
      Left            =   3720
      TabIndex        =   2
      Top             =   240
      Width           =   975
   End
   Begin VB.TextBox txtStuNo 
      DataField       =   "学号"
      DataMember      =   "dbo_stu_GetAllStudent"
      DataSource      =   "DataEnvironment1"
      Height          =   285
      Left            =   1320
      TabIndex        =   1
      Top             =   210
      Width           =   1935
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGridPunish 
      Height          =   1695
      Left            =   7080
      TabIndex        =   22
      Top             =   2640
      Width           =   3255
      _ExtentX        =   5741
      _ExtentY        =   2990
      _Version        =   393216
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGridReward 
      Height          =   1695
      Left            =   3600
      TabIndex        =   23
      Top             =   2640
      Width           =   3255
      _ExtentX        =   5741
      _ExtentY        =   2990
      _Version        =   393216
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
   Begin VB.Label Label3 
      Caption         =   "处罚情况列表:"
      Height          =   255
      Left            =   7080
      TabIndex        =   20
      Top             =   2400
      Width           =   1455
   End
   Begin VB.Label Label2 
      Caption         =   "奖励情况列表:"
      Height          =   255
      Left            =   3600
      TabIndex        =   19
      Top             =   2400
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "学籍变更列表:"
      Height          =   255
      Left            =   120
      TabIndex        =   18
      Top             =   2400
      Width           =   1575
   End
   Begin VB.Label lblFieldLabel 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "输入学号:"
      Height          =   180
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   255
      Width           =   1050
   End
End
Attribute VB_Name = "FrmSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim cmd As ADODB.Command
Public strStuNo As String           ' 当前记录学号
Public iCurrentPos As Integer       ' 当前GetAllStudent的游标位置


' 根据学号执行存储过程查询资料
Private Sub Search()   '查询功能函数
        Set cmd = New ADODB.Command
                
        If Len(LTrim(txtStuNo.Text)) <> 0 Then
                strStuNo = txtStuNo.Text
        Else
                MsgBox "请输入学号!"
                Exit Sub
        End If

        ' 填充学生基本情况
        FillStuBasic strStuNo
                
        ' 填充学籍变更列表
        FillChangeList strStuNo
        ' 显示第一列的学籍变更列表和情况
        If MSHFlexGridChange.Col > 0 Then
                FillChangeTypeAndDes MSHFlexGridChange.TextMatrix(1, 1)
                cmdChangeEdit.Enabled = True
                cmdChangeCancel.Enabled = True
        Else
                cmdChangeEdit.Enabled = False
                cmdChangeCancel.Enabled = False
        End If
        
        ' 填充奖励情况列表
        FillRewardList strStuNo
        ' 显示第一列的奖励列表和情况
        If MSHFlexGridReward.Col > 0 Then
                FillRewardTypeAndDes MSHFlexGridReward.TextMatrix(1, 1)
                cmdRewardEdit.Enabled = True
                cmdRewardCancel.Enabled = True
        Else
                cmdRewardEdit.Enabled = False
                cmdRewardCancel.Enabled = False
        End If
        
        
        ' 填充处罚情况列表
        FillPunishList strStuNo
        ' 显示第一列的处罚列表和情况
        If MSHFlexGridPunish.Col > 0 Then
                FillPunishTypeAndDes MSHFlexGridPunish.TextMatrix(1, 1)
                cmdPunishEdit.Enabled = True
                cmdPunishCancel.Enabled = True
        Else
                cmdPunishEdit.Enabled = False
                cmdPunishCancel.Enabled = False
        End If
        
End Sub


' 填充学生基本情况
Private Sub FillStuBasic(stuNo As String)

        Dim cmd As New Command
        If cnn.State <> adStateOpen Then
            cnn.Open strCnn
        End If
        On Error GoTo ErrHandle
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "stu_GetStuSummary2"
        
        cmd.Parameters.Append cmd.CreateParameter("@stuNo", adChar, adParamInput, 6)
        cmd.Parameters.Append cmd.CreateParameter("@name", adVarChar, adParamOutput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@sex", adChar, adParamOutput, 2)
        cmd.Parameters.Append cmd.CreateParameter("@birthday", adDate, adParamOutput)
        cmd.Parameters.Append cmd.CreateParameter("@native", adVarChar, adParamOutput, 50)
        cmd.Parameters.Append cmd.CreateParameter("@departName", adVarChar, adParamOutput, 50)
        cmd.Parameters.Append cmd.CreateParameter("@className", adVarChar, adParamOutput, 50)

        cmd.Parameters("@stuNo").Value = stuNo
        cmd.Execute
        
        txtName.Text = cmd.Parameters("@name").Value
        cmbSex.Text = cmd.Parameters("@sex").Value
        txtBirth.Text = cmd.Parameters("@birthday").Value
        txtNative.Text = Trim(cmd.Parameters("@native").Value)
        dtcmbDpeart.Text = cmd.Parameters("@departName").Value
        dtcmbClass.Text = cmd.Parameters("@className").Value
        cnn.Close
        Set cnn = Nothing
        Exit Sub
ErrHandle:
        MsgBox Err.Description
End Sub

' 填充学籍变更列表
Private Sub FillChangeList(stuNo As String)

        Dim cmdChange As New Command
        Dim rsChange As New Recordset
        
        If cnn.State <> adStateOpen Then
            cnn.Open strCnn
        End If
        cmdChange.ActiveConnection = cnn
        cmdChange.CommandType = adCmdStoredProc
        cmdChange.CommandText = "stu_GetChangeByNO"
        cmdChange.Parameters.Append cmdChange.CreateParameter("@stuNo", adChar, adParamInput, 6)
        cmdChange.Parameters("@stuNo").Value = stuNo
        
        ' 绑定
        With rsChange
                .ActiveConnection = cnn
                .CursorLocation = adUseClient
                .CursorType = adOpenStatic
        End With
        MSHFlexGridChange.Clear
        Set rsChange = cmdChange.Execute()
        Set MSHFlexGridChange.DataSource = rsChange
        
        cnn.Close
        Set cnn = Nothing
End Sub

' 填充奖励情况列表
Private Sub FillRewardList(stuNo As String)

        Dim cmdReward As New Command
        Dim rsReward As New Recordset
        
        If cnn.State <> adStateOpen Then
            cnn.Open strCnn
        End If
        cmdReward.ActiveConnection = cnn
        cmdReward.CommandType = adCmdStoredProc
        cmdReward.CommandText = "stu_GetRewardByNO"
        cmdReward.Parameters.Append cmdReward.CreateParameter("@stuNo", adChar, adParamInput, 6)
        cmdReward.Parameters("@stuNo").Value = stuNo
        
        ' 绑定
        With rsReward
                .ActiveConnection = cnn
                .CursorLocation = adUseClient
                .CursorType = adOpenStatic
        End With
        
        Set rsReward = cmdReward.Execute()
        
        Set MSHFlexGridReward.DataSource = rsReward

        cnn.Close
        Set cnn = Nothing
End Sub

' 填充处罚情况列表
Private Sub FillPunishList(stuNo As String)
        Dim cnn As New Connection
        Dim cmdPunish As New Command