📄 forminput.frm
字号:
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 + -