frmaddreward.frm

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

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form FrmAddReward 
   Caption         =   "奖励情况输入"
   ClientHeight    =   4665
   ClientLeft      =   60
   ClientTop       =   390
   ClientWidth     =   7605
   LinkTopic       =   "Form1"
   ScaleHeight     =   4665
   ScaleWidth      =   7605
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "学生基本情况"
      Height          =   1815
      Left            =   3840
      TabIndex        =   5
      Top             =   240
      Width           =   3495
      Begin VB.Label Label4 
         Caption         =   "姓名:"
         Height          =   255
         Left            =   360
         TabIndex        =   11
         Top             =   360
         Width           =   615
      End
      Begin VB.Label Label5 
         Caption         =   "院系:"
         Height          =   255
         Left            =   360
         TabIndex        =   10
         Top             =   840
         Width           =   615
      End
      Begin VB.Label Label6 
         Caption         =   "班级:"
         Height          =   255
         Left            =   360
         TabIndex        =   9
         Top             =   1320
         Width           =   615
      End
      Begin VB.Label lblName 
         Height          =   255
         Left            =   1080
         TabIndex        =   8
         Top             =   360
         Width           =   2055
      End
      Begin VB.Label lblDepartment 
         Height          =   255
         Left            =   1080
         TabIndex        =   7
         Top             =   840
         Width           =   2175
      End
      Begin VB.Label lblClass 
         Height          =   255
         Left            =   1080
         TabIndex        =   6
         Top             =   1320
         Width           =   2175
      End
   End
   Begin VB.TextBox txtStuNo 
      Height          =   270
      Left            =   1320
      TabIndex        =   4
      Top             =   360
      Width           =   1935
   End
   Begin VB.TextBox txtMemo 
      Height          =   1335
      Left            =   240
      TabIndex        =   2
      Top             =   2280
      Width           =   7095
   End
   Begin VB.CommandButton CmdAppend 
      Caption         =   "添加"
      Height          =   375
      Left            =   2040
      TabIndex        =   1
      Top             =   3960
      Width           =   975
   End
   Begin VB.CommandButton CmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   4320
      TabIndex        =   0
      Top             =   3960
      Width           =   975
   End
   Begin MSDataListLib.DataCombo DataCombo1 
      Height          =   330
      Left            =   1320
      TabIndex        =   3
      Top             =   960
      Width           =   1935
      _ExtentX        =   3413
      _ExtentY        =   582
      _Version        =   393216
      Text            =   ""
   End
   Begin VB.Label Label1 
      Caption         =   "输入学号:"
      Height          =   255
      Left            =   360
      TabIndex        =   14
      Top             =   360
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "奖励级别:"
      Height          =   255
      Left            =   360
      TabIndex        =   13
      Top             =   1080
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "具体描述:"
      Height          =   255
      Left            =   360
      TabIndex        =   12
      Top             =   2040
      Width           =   975
   End
End
Attribute VB_Name = "FrmAddReward"
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 ' 当前记录学号

Private Sub Form_Load()

        
        txtStuNo.Text = strStuNo
        
        ' 填充奖励级别下拉列表
        Set DataCombo1.RowSource = DataEnvironment1
        DataCombo1.RowMember = "dbo_stu_GetRewardCode"
        DataCombo1.ListField = "description"
        DataEnvironment1.rsdbo_stu_GetRewardCode.MoveFirst
        DataCombo1.Text = DataEnvironment1.rsdbo_stu_GetRewardCode("Description").Value
        
        ' 在LABLE中显示学生基本情况
        If strStuNo <> "" Then
                Dim Rs As New Recordset
                Set cmd = New ADODB.Command
                
                If cnn.State <> adStateOpen Then
                    cnn.Open strCnn
                End If
                
                cmd.ActiveConnection = cnn
                cmd.CommandType = adCmdStoredProc
                cmd.CommandText = "stu_GetStuSummary"
                
                cmd.Parameters.Append cmd.CreateParameter("@stuNo", adChar, adParamInput, 6)
                cmd.Parameters.Append cmd.CreateParameter("@stuName", adVarChar, adParamOutput, 20)
                cmd.Parameters.Append cmd.CreateParameter("@departName", adVarChar, adParamOutput, 50)
                cmd.Parameters.Append cmd.CreateParameter("@className", adVarChar, adParamOutput, 50)
                'cmd.Parameters.Refresh
  
                cmd.Parameters("@stuNo").Value = txtStuNo.Text
  
                Set Rs.Source = cmd
                Rs.Open
                Set Rs = cmd.Execute
                lblName.Caption = cmd("@stuName")
                lblDepartment.Caption = cmd("@departName")
                lblClass.Caption = cmd("@className")
                cnn.Close
                Set cnn = Nothing
        End If
        
End Sub

Private Sub Form_Unload(Cancel As Integer)

        If cnn.State = adStateOpen Then
                cnn.Close
                Set cnn = Nothing
        End If

End Sub
' 添加奖励记录
Private Sub Append() '添加记录子函数
        On Error GoTo ErrHandle
        

        Set cmd = New ADODB.Command
        
        If cnn.State <> adStateOpen Then
            cnn.Open strCnn
        End If
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "stu_AddRewardRecord"
        
        cmd.Parameters.Append cmd.CreateParameter("@stuNo", adChar, adParamInput, 6)
        cmd.Parameters.Append cmd.CreateParameter("@RewardDes", adVarChar, adParamInput, 50)
        cmd.Parameters.Append cmd.CreateParameter("@memo", adVarChar, adParamInput, 1000)
        cmd.Parameters("@stuNo").Value = txtStuNo.Text
        cmd.Parameters("@RewardDes").Value = DataCombo1.Text
        cmd.Parameters("@memo").Value = txtMemo.Text
        cmd.Execute
        MsgBox "添加成功!"
        cnn.Close
        Set cnn = Nothing
        Exit Sub
ErrHandle:
        MsgBox Err.Description
End Sub

Private Sub cmdAppend_Click() '添加
        Append
End Sub

Private Sub cmdcancel_Click() '取消
        Unload Me
End Sub