frmscoreupdate.frm

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

         Height          =   180
         Left            =   3480
         TabIndex        =   18
         Top             =   2640
         Width           =   1080
      End
      Begin VB.Label Label15 
         AutoSize        =   -1  'True
         Caption         =   "%"
         Height          =   180
         Left            =   5820
         TabIndex        =   17
         Top             =   2640
         Width           =   90
      End
      Begin VB.Label Label10 
         AutoSize        =   -1  'True
         Caption         =   "合计"
         Height          =   180
         Left            =   300
         TabIndex        =   16
         Top             =   3180
         Width           =   360
      End
      Begin VB.Label Label11 
         AutoSize        =   -1  'True
         Caption         =   "名次"
         Height          =   180
         Left            =   3480
         TabIndex        =   15
         Top             =   3180
         Width           =   360
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "测评日期"
         Height          =   180
         Left            =   300
         TabIndex        =   14
         Top             =   1020
         Width           =   720
      End
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   400
      Left            =   7380
      TabIndex        =   0
      Top             =   600
      Width           =   1245
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   400
      Left            =   7380
      TabIndex        =   1
      Top             =   1260
      Width           =   1245
   End
End
Attribute VB_Name = "FrmScoreUpdate"
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                                  '学生内码
    Rs!SYear1 = FrmScore.CboYear1.Text                '学年1
    Rs!SYear2 = FrmScore.CboYear2.Text                '学年2
    Rs!Sterm = FrmScore.CboTerm.Text                  '学期
  End If
  If IsDate(DtDate.Value) Then                          '测评日期
    Rs!SDate = Format(DtDate.Value, "yyyy-mm-dd")
  Else
    Rs!SDate = Null
  End If
  Rs!SMoral = Val(txtSMoral.Text)                     '德育分数
  Rs!SMoralper = Val(txtSMoralPer.Text)                 '德育所占比例
  Rs!SMind = Val(txtSMind.Text)                       '智育分数
  Rs!SMindper = Val(txtSMindPer.Text)                 '智育所占比例
  Rs!SGmy = Val(txtSGmy.Text)                         '体育分数
  Rs!SGmyper = Val(txtSGmyPer.Text)                   '体育所占比例
  Rs!STotal = Val(txtSTotal.Text)                       '合计
  Rs!SOrder = Val(txtSOrder.Text)                       '名次
  Rs!SMemo = txtMemo.Text                             '备注
  Rs.Update
End Sub

Private Sub Form_Load()
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  
  If ModifyFlag = 0 Then      '添加记录，需要清空各控件中的内容
    DtDate.Value = Date
    txtSMoral.Text = ""
    txtSMoralPer.Text = "20"
    txtSMind.Text = ""
    txtSMindPer.Text = "70"
    txtSGmy.Text = ""
    txtSGmyPer.Text = "10"
    txtSTotal.Text = ""
    txtSOrder.Text = ""
    txtMemo.Text = ""
  Else                        '修改记录，在控件中填充内容
    strSql = "select * from Score where ID='" & FrmScore.m_ScoreID & "'"
    Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
    DtDate.Value = IIf(IsDate(Rs!SDate), Rs!SDate, Null)
    txtSMoral.Text = IIf(IsNull(Rs!SMoral), "", Rs!SMoral)
    txtSMoralPer.Text = IIf(IsNull(Rs!SMoralper), "", Rs!SMoralper)
    txtSMind.Text = IIf(IsNull(Rs!SMind), "", Rs!SMind)
    txtSMindPer.Text = IIf(IsNull(Rs!SMindper), "", Rs!SMindper)
    txtSGmy.Text = IIf(IsNull(Rs!SGmy), "", Rs!SGmy)
    txtSGmyPer.Text = IIf(IsNull(Rs!SGmyper), "", Rs!SGmyper)
    txtSTotal.Text = IIf(IsNull(Rs!STotal), "", Rs!STotal)
    txtSOrder.Text = IIf(IsNull(Rs!SOrder), "", Rs!SOrder)
    txtMemo.Text = IIf(IsNull(Rs!SMemo), "", Rs!SMemo)
    Rs.Close
    Set Rs = Nothing
  End If
  '给学号和姓名赋值
  txtStuNo.Text = FrmScore.ListView1.SelectedItem.Text
  txtStuName.Text = FrmScore.ListView1.SelectedItem.SubItems(1)
End Sub

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

Private Sub txtSMoral_Change()
  Dim dblMoral As Double
  Dim dblMind As Double
  Dim dblGmy As Double
  Dim dblTotal As Double
  
  '计算德育部分分数
  dblMoral = Val(txtSMoral.Text) * Val(txtSMoralPer.Text) / 100
  '计算智育部分分数
  dblMind = Val(txtSMind.Text) * Val(txtSMindPer.Text) / 100
  '计算体育部分分数
  dblGmy = Val(txtSGmy.Text) * Val(txtSGmyPer.Text) / 100
  '计算总分
  dblTotal = dblMoral + dblMind + dblGmy
  '格式化总分，显示在"合计"文本框中
  txtSTotal.Text = Format(dblTotal, "0.0000")
End Sub

Private Sub txtSMoralPer_Change()
  Call txtSMoral_Change     '调用txtSMoral_Change事件过程
End Sub

Private Sub txtSMind_Change()
  Call txtSMoral_Change     '调用txtSMoral_Change事件过程
End Sub

Private Sub txtSMindPer_Change()
  Call txtSMoral_Change     '调用txtSMoral_Change事件过程
End Sub

Private Sub txtSGmy_Change()
  Call txtSMoral_Change     '调用txtSMoral_Change事件过程
End Sub

Private Sub txtSGmyPer_Change()
  Call txtSMoral_Change     '调用txtSMoral_Change事件过程
End Sub

Private Sub cmdOk_Click()
  On Error GoTo ErrorHandle
  Dim sID As String
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  Dim itmX As ListItem
  Dim Tmp_Key As String

  '检查德智体分数比例的正确性
  If Val(txtSMoralPer.Text) + Val(txtSMindPer.Text) + Val(txtSGmyPer.Text) <> 100 Then
    MsgBox "所占比例相加未满足100，请重新设置", _
                vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If

  '获取当前学生内码
  sStuID = Right(FrmScore.ListView1.SelectedItem.Key, _
                  Len(FrmScore.ListView1.SelectedItem.Key) - 1)
  If ModifyFlag = 0 Then      '添加记录
    '打开测评信息记录集（空记录集）
    strSql = "SELECT top 0 * FROM Score"
    Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
    '调用Update_Data过程，向Score表中添加测评信息
    Call Update_Data(Rs, sStuID, ModifyFlag)
    sID = Rs!ID   '保存所添加测评记录的内码
  Else              '修改记录
    sID = FrmScore.m_ScoreID    '保存需要修改测评记录的内码
    '查询获取要修改测评信息的记录集（仅一条记录）
    strSql = "SELECT * FROM Score WHERE ID='" & sID & "'"
    Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
    If Not Rs.EOF Then
      '调用Update_Data过程，修改测评信息
      Call Update_Data(Rs, sStuID, ModifyFlag)
    End If
  End If
  Rs.Close
  Set Rs = Nothing

  '刷新显示当前所添加或修改的测评信息
  Call FrmScore.ShowScoreDetail(sStuID)

  Unload Me
  
  On Error GoTo 0
  Exit Sub
  
ErrorHandle:
  MsgBox Error(Err.Number), vbExclamation + vbOKOnly, "操作提示"
End Sub

Private Sub cmdCancel_Click()
  Unload Me
End Sub