frmprizeupdate.frm

适用一般于毕业设计！ VB代码源加SQL 数据库 ··

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FrmPrizeUpdate 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "编辑奖励信息"
   ClientHeight    =   5250
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8430
   Icon            =   "FrmPrizeUpdate.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5250
   ScaleWidth      =   8430
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   4935
      Left            =   180
      TabIndex        =   3
      Top             =   120
      Width           =   6555
      Begin VB.TextBox txtStuName 
         Enabled         =   0   'False
         Height          =   375
         Left            =   1260
         TabIndex        =   0
         Text            =   "StuName"
         Top             =   300
         Width           =   2775
      End
      Begin VB.TextBox txtReason 
         Height          =   1455
         Left            =   1260
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   5
         Text            =   "FrmPrizeUpdate.frx":06EA
         Top             =   1260
         Width           =   5055
      End
      Begin VB.TextBox txtDetail 
         Height          =   1875
         Left            =   1260
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   4
         Text            =   "FrmPrizeUpdate.frx":06F3
         Top             =   2820
         Width           =   5055
      End
      Begin MSComCtl2.DTPicker DtDate 
         Height          =   375
         Left            =   1260
         TabIndex        =   10
         Top             =   780
         Width           =   1755
         _ExtentX        =   3096
         _ExtentY        =   661
         _Version        =   393216
         CheckBox        =   -1  'True
         Format          =   25559041
         CurrentDate     =   2
         MaxDate         =   109939
         MinDate         =   2
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "学生姓名"
         Height          =   180
         Left            =   300
         TabIndex        =   9
         Top             =   420
         Width           =   720
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "奖励原因"
         Height          =   180
         Left            =   300
         TabIndex        =   8
         Top             =   1380
         Width           =   720
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "奖励日期"
         Height          =   180
         Left            =   300
         TabIndex        =   7
         Top             =   900
         Width           =   720
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "详细说明"
         Height          =   180
         Left            =   300
         TabIndex        =   6
         Top             =   2940
         Width           =   720
      End
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   400
      Left            =   6960
      TabIndex        =   1
      Top             =   600
      Width           =   1245
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   400
      Left            =   6960
      TabIndex        =   2
      Top             =   1260
      Width           =   1245
   End
End
Attribute VB_Name = "FrmPrizeUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Update_Data(Rs As ADODB.Recordset, _
                        StuID As String, ByVal mFlag As Integer)
  '参数Rs：奖励信息记录集
  '参数StuID：学生内码
  '参数mFlag：插入/修改标志，0-新增；1-修改
  If mFlag = 0 Then
    Rs.AddNew
    Rs!ID = GetRndCode                                '生成新内码
    Rs!StuID = StuID                                  '学生内码
  End If
  If IsDate(DtDate.Value) Then                          '奖励日期
    Rs!PDate = Format(DtDate.Value, "yyyy-mm-dd")
  Else
    Rs!PDate = Null
  End If
  Rs!PReason = txtReason.Text                         '奖励原因
  Rs!PDetail = txtDetail.Text                           '详细说明
  Rs.Update
End Sub

Private Sub Form_Load()
  If ModifyFlag = 0 Then      '添加记录，需要清空各控件中的内容
    txtStuName.Text = FrmPrize.ListView1.SelectedItem.SubItems(1)
    DtDate.Value = Date
    txtReason.Text = ""
    txtDetail.Text = ""
  Else                        '修改记录，在控件中填充内容
    With FrmPrize
      txtStuName.Text = .rsPrize!StuName
      DtDate.Value = IIf(IsDate(.rsPrize!PDate), .rsPrize!PDate, Null)
      txtReason.Text = IIf(IsNull(.rsPrize!PReason), "", .rsPrize!PReason)
      txtDetail.Text = IIf(IsNull(.rsPrize!PDetail), "", .rsPrize!PDetail)
    End With
  End If
  
  txtStuName.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set FrmPrizeUpdate = Nothing
End Sub

Private Sub cmdOk_Click()
  On Error GoTo ErrorHandle
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  Dim blnState As Boolean   '标志变量：True-事务未全部完成，False-全部完成

  '获取学生内码
  sStuID = Right(FrmPrize.ListView1.SelectedItem.Key, _
                 Len(FrmPrize.ListView1.SelectedItem.Key) - 1)
                 
  Conn.BeginTrans   '开始事务
  blnState = True     '设置标志状态
  
  If ModifyFlag = 0 Then      '添加记录
    '打开奖励信息记录集（空记录集）
    strSql = "SELECT top 0 * FROM Prize"
    Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
    '调用Update_Data过程，向Prize表中添加奖励信息
    Call Update_Data(Rs, sStuID, ModifyFlag)
    
    '同时把当前记录添加到RsPrize记录集中，以便在DataGrid控件上显示出来
    'RsPrize是批更新模式，记录集的添加不会影响到所涉及的数据表中的数据
    With FrmPrize
      .rsPrize.AddNew
      .rsPrize!ID = Rs!ID         '奖励记录内码
      .rsPrize!StuID = Rs!StuID       '学生内码
      .rsPrize!PDate = Rs!PDate       '奖励日期
      .rsPrize!PReason = Rs!PReason     '奖励原因
      .rsPrize!PDetail = Rs!PDetail     '详细说明
      .rsPrize!StuName = txtStuName.Text    '学生姓名
      .rsPrize.Update
    End With
  Else              '修改记录
    '查询获取要修改奖励信息的记录集（仅一条记录）
    strSql = "SELECT * FROM Prize WHERE ID='" & FrmPrize.rsPrize!ID & "'"
    Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
    If Not Rs.EOF Then
      '调用Update_Data过程，修改奖励信息
      Call Update_Data(Rs, sStuID, ModifyFlag)
    End If
    
    '同时要修改RsPrize记录集中的当前记录，以便在DataGrid控件上显示出来
    'RsPrize是批更新模式，记录集的修改不会影响到所涉及的数据表中的数据
    With FrmPrize
      .rsPrize!PDate = Rs!PDate
      .rsPrize!PReason = Rs!PReason
      .rsPrize!PDetail = Rs!PDetail
      .rsPrize!StuName = txtStuName.Text
      .rsPrize.Update
    End With
  End If
  Rs.Close
  Set Rs = Nothing
  
  Conn.CommitTrans    '提交事务
  blnState = False      '取消标志状态

  Unload Me
  
  On Error GoTo 0
  Exit Sub
  
ErrorHandle:
  If blnState = True Then Conn.RollbackTrans    '在事务中发生错误，回滚事务
  MsgBox Error(Err.Number), vbExclamation + vbOKOnly, "操作提示"
End Sub

Private Sub cmdCancel_Click()
  Unload Me
End Sub