frmpunishupdate.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FrmPunishUpdate 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "编辑惩罚信息"
   ClientHeight    =   5250
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8430
   Icon            =   "FrmPunishUpdate.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            =   "FrmPunishUpdate.frx":06EA
         Top             =   1260
         Width           =   5055
      End
      Begin VB.TextBox txtDetail 
         Height          =   1875
         Left            =   1260
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   4
         Text            =   "FrmPunishUpdate.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          =   56426497
         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 = "FrmPunishUpdate"
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 = FrmPunish.ListView1.SelectedItem.SubItems(1)
    DtDate.Value = Date
    txtReason.Text = ""
    txtDetail.Text = ""
  Else                        '修改记录，在控件中填充内容
    With FrmPunish
      txtStuName.Text = .rsPunish!StuName
      DtDate.Value = IIf(IsDate(.rsPunish!PDate), .rsPunish!PDate, Null)
      txtReason.Text = IIf(IsNull(.rsPunish!PReason), "", .rsPunish!PReason)
      txtDetail.Text = IIf(IsNull(.rsPunish!PDetail), "", .rsPunish!PDetail)
    End With
  End If
  
  txtStuName.Enabled = False
End Sub

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