⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 forminput.frm

📁 评语编辑系统 评语编辑系统 评语编辑系统 评语编辑系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   8520
      TabIndex        =   5
      Top             =   4680
      Width           =   525
   End
End
Attribute VB_Name = "FormInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Selstr As String '在DataGrid上选择的字符
Dim NowCase As String '当前是什么情况
Dim Jump As Integer
Dim IsEdit As Boolean
Private Sub cmdadd_Click()
   Dim listitem As listitem
   If RSStudent.State = 1 Then RSStudent.Close: Set RSStudent = Nothing
   RSStudent.Open "select * from [学生信息] where 学号='" & txtname.Text & "'", AdoCnn, adOpenDynamic, adLockOptimistic
   If Not RSStudent.EOF Then MsgBox "学号" & txtname.Text & "已经存在,请另换学号.", vbCritical, "提示!": Exit Sub
   RSStudent.AddNew
   RSStudent("姓名").Value = Trim(txtno.Text)
   RSStudent("学号").Value = Trim(txtname.Text)
   Set listitem = LvwStudents.ListItems.Add(, , Trim(txtno.Text))
       listitem.SubItems(1) = Trim(txtname.Text)
   RSStudent.Update
End Sub
Private Sub cmdback_Click()
  Save_Remark
End Sub
Private Sub cmddel_Click()
    If MsgBox("真的要删除吗?", vbOKCancel, "删除提示!") = vbOK Then
        Dim i As Integer
        If RSStudent.State = 1 Then RSStudent.Close: Set RSStudent = Nothing
        For i = LvwStudents.ListItems.Count To 1 Step -1
            If LvwStudents.ListItems(i).Selected = True Then
               RSStudent.Open "delete from [学生信息] where 学号='" & LvwStudents.ListItems(i).SubItems(1) & "'", AdoCnn
               LvwStudents.ListItems.Remove (i)
            End If
        Next
         MsgBox "删除成功!", vbExclamation, "删除"
    End If
End Sub
Private Sub cmdeditdemo_Click()
  IsEdit = Not IsEdit
  If IsEdit = True Then
    MsgBox "编辑完后请点击<编辑完成>才能进行评语录入!", vbExclamation, "提示!"
    cmdeditdemo.Caption = "编辑完成(&S)"
    DataGrid1.ForeColor = &HC0&          '&H00FFC0C0&
    DataGrid1.MarqueeStyle = dbgSolidCellBorder
    DataGrid1.Appearance = dbgFlat
    DataGrid1.AllowAddNew = True '允许添加
    DataGrid1.AllowUpdate = True '允许更新
    DataGrid1.Refresh
    cmdeditdemo.BackColor = vbRed             '&H00C0C0FF&
  Else '返回编辑时恢复控件属性
    cmdeditdemo.Caption = "例句编辑(&E)"
    cmdeditdemo.BackColor = &H8000000F
    DataGrid1.MarqueeStyle = dbgHighlightCell
    DataGrid1.Appearance = dbg3D
    DataGrid1.AllowAddNew = False '允许添加
    DataGrid1.AllowUpdate = False '允许更新
    DataGrid1.ForeColor = &H80000007         '&H00FFC0C0&
  End If
End Sub
Private Sub cmdsaveback_Click()
   Save_Remark
   Unload Me
End Sub
Private Sub DataGrid1_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
   Selstr = DataGrid1.Text
   If InStr(1, Selstr, "**************") Then
       MsgBox "这是分隔符,你不能编辑!", vbCritical, "提示!"
       Exit Sub
   End If
   Selstr = ""
End Sub
Private Sub DataGrid1_DblClick() '双击输入
   If IsEdit = True Then Exit Sub
   If InStr(1, Selstr, "**************") Then Exit Sub
   If Trim(txtremark.Text) = "" Then txtremark.Text = "    "
   txtremark.Text = txtremark.Text & Selstr
  If Jump > 8 Then
           Jump = 0
           If MsgBox("该评语保存为: " & LvwStudents.SelectedItem.Text & ";   学号:" & LvwStudents.SelectedItem.SubItems(1), vbOKCancel, "评语保存") = vbOK Then
                  '保存评语
                  Save_Remark
                  '保存评语
           End If
           LvwStudents.ListItems(LvwStudents.SelectedItem.Index).Selected = False
           If LvwStudents.SelectedItem.Index = LvwStudents.ListItems.Count Then
                  MsgBox "已经是最后一位了!", vbExclamation, "评语保存"
                  LvwStudents.ListItems(LvwStudents.SelectedItem.Index).Selected = True
           Exit Sub
           End If
           LvwStudents.ListItems(LvwStudents.SelectedItem.Index + 1).Selected = True
           txtremark.Text = "    "
           Show_Remark LvwStudents.SelectedItem.SubItems(1)
         End If
         SSTab.Tab = Jump
End Sub
Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
   Selstr = DataGrid1.Text
   If InStr(1, Selstr, "**************") Then
       MsgBox "这是分隔符,你不能编辑!", vbCritical, "提示!"
       Exit Sub
   End If
   Selstr = ""
End Sub
Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   If IsEdit = True Then Exit Sub '单击输入
   If IsClick = True Then
        Selstr = DataGrid1.Text
        If InStr(1, Selstr, "**************") Then Exit Sub
        If Trim(txtremark.Text) = "" Then txtremark.Text = "    "
        txtremark.Text = txtremark.Text & Selstr
        If Jump > 8 Then
           Jump = 0
           If MsgBox("该评语保存为: " & LvwStudents.SelectedItem.Text & ";   学号:" & LvwStudents.SelectedItem.SubItems(1), vbOKCancel, "评语保存") = vbOK Then
                  '保存评语
                  Save_Remark
                  '保存评语
           End If
           LvwStudents.ListItems(LvwStudents.SelectedItem.Index).Selected = False
           If LvwStudents.SelectedItem.Index = LvwStudents.ListItems.Count Then
                  MsgBox "已经是最后一位了!", vbExclamation, "评语保存"
                  LvwStudents.ListItems(LvwStudents.SelectedItem.Index).Selected = True
           Exit Sub
           End If
           LvwStudents.ListItems(LvwStudents.SelectedItem.Index + 1).Selected = True
           txtremark.Text = "    "
           Show_Remark LvwStudents.SelectedItem.SubItems(1)
         
         End If
         SSTab.Tab = Jump
    End If
End Sub
Private Sub Form_Load()
   ' sutra
   NotOnTop FormInput '使主窗体不位于顶层
   StayOnTop Me '使当前窗体位于顶层
   CenterForm Me '使当前窗体居中
   SSTab.Tab = 0
   ResizeInit Me '读取各初始控件的位置及尺寸
   '*****************
    If AdoCnn.State = 0 Then AdoCnn.Open CnStr
   Set RS = Nothing
   Show_DataGrid
   DatagridWhoShow "印象"
   '初始化学生列表
   LvwStudents.View = lvwReport
   LvwStudents.ColumnHeaders.Add , "col1", "姓名", LvwStudents.Width / 3
   LvwStudents.ColumnHeaders.Add , "coll2", "学号", (LvwStudents.Width / 3) * 2 + 200, lvwColumnCenter
   
   '初始化学生列表
   Jump = 1
   Show_Studentsinfo
   LvwStudents.HideSelection = False '列表控件选择显示
   txtno.Text = LvwStudents.SelectedItem '把列表中被选择的项的数据显示在文本框中
   txtname.Text = LvwStudents.SelectedItem.SubItems(1) '把列表中被选择的项的数据显示在文本框中
   Show_Remark LvwStudents.SelectedItem.SubItems(1)
End Sub
Private Sub Form_Resize()
  ResizeForm Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
   'StayOnTop formMain
End Sub
Private Sub LvwStudents_Click()
   On Error Resume Next '当全部删除完之后,会出现错误
   txtno.Text = LvwStudents.SelectedItem
   txtname.Text = LvwStudents.SelectedItem.SubItems(1)
   Show_Remark LvwStudents.SelectedItem.SubItems(1)
End Sub
Private Sub LvwStudents_DblClick()
    MsgBox LvwStudents.SelectedItem.SubItems(1)
End Sub
Private Sub LvwStudents_KeyUp(KeyCode As Integer, Shift As Integer)
    'LvwStudents.SelectedItem = LvwStudents.ListItems(LvwStudents.SelectedItem.Index)
    txtno.Text = LvwStudents.SelectedItem
    txtname.Text = LvwStudents.SelectedItem.SubItems(1)
    Show_Remark LvwStudents.SelectedItem.SubItems(1)
End Sub
Private Sub SSTab_Click(PreviousTab As Integer)
  Select Case SSTab.Tab
     Case 0
       Jump = 1
       DatagridWhoShow "印象"
     Case 1
       Jump = 2
       DatagridWhoShow "上课"
     Case 2
       Jump = 3
       DatagridWhoShow "作业"
     Case 3
       Jump = 4
       DatagridWhoShow "学习"
     Case 4
       Jump = 5
       DatagridWhoShow "班务"
     Case 5
       Jump = 6
       DatagridWhoShow "交际"
     Case 6
       Jump = 7
       DatagridWhoShow "特长"
     Case 7
       Jump = 8
       DatagridWhoShow "问题"
     Case 8
       Jump = 9
       DatagridWhoShow "希望"
  End Select
End Sub
Sub Show_DataGrid() '把整张表读出来
   DataGrid1.Font.Size = 12
   If RS.State = 1 Then RS.Close: Set RS = Nothing
   AdoCnn.CursorLocation = adUseClient '没有这一句则DataGrid中无数据
   RS.Open "select * from[评语] order by 编号 asc", AdoCnn, adOpenStatic, adLockOptimistic
   Set DataGrid1.DataSource = RS
   DataGrid1.Refresh
End Sub
Sub DatagridWhoShow(Who As String) '分情况显示评语
    'RS.MoveFirst
    Dim i As Integer
    For i = 1 To DataGrid1.Columns.Count - 1
        DataGrid1.Columns(i).Visible = False
    Next
    DataGrid1.Columns("编号").Width = 800: DataGrid1.Columns("编号").Visible = True
    DataGrid1.Columns(Who).Width = DataGrid1.Width * (7 / 8): DataGrid1.Columns(Who).Visible = True
End Sub
Sub Show_Studentsinfo() 'use in  姓名,学号
    Dim SubItem As listitem
    Dim Str As String
    If RSStudent.State = 1 Then RSStudent.Close: Set RSStudent = Nothing
    RSStudent.CursorType = adOpenDynamic
    RSStudent.LockType = adLockOptimistic
    Str = "select * from [学生信息] order by 学号"
    RSStudent.Open Str, AdoCnn
    With LvwStudents
      Do While Not RSStudent.EOF
        Set SubItem = .ListItems.Add(, , RSStudent("姓名"))
        SubItem.SubItems(1) = RSStudent("学号")
        RSStudent.MoveNext
      Loop
   End With
End Sub
Sub Show_Remark(Str As String)
     On Error Resume Next   '主要是避免记录中得到Null值而引起的错误。
     Dim RsRemark As New ADODB.Recordset
     RsRemark.Open "select 评语 from [学生信息] where 学号='" & Str & "' ", AdoCnn
     txtremark.Text = ""
     txtremark.Text = RsRemark("评语").Value
'     txtremark.Text = ""
'     RSStudent.Filter = "学号='" & Str & "'"
'     txtremark.Text = RSStudent("评语").Value
End Sub
Sub Save_Remark()
    AdoCnn.Execute "update [学生信息] set 评语='" & txtremark.Text & "' where 学号='" & LvwStudents.SelectedItem.SubItems(1) & "'"
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -