📄 frmpyglxt.frm
字号:
TabCaption(3) = "学习"
TabPicture(3) = "FrmPyglxt.frx":7675
Tab(3).ControlEnabled= 0 'False
Tab(3).Control(0)= "List1(3)"
Tab(3).ControlCount= 1
TabCaption(4) = "班务"
TabPicture(4) = "FrmPyglxt.frx":7691
Tab(4).ControlEnabled= 0 'False
Tab(4).Control(0)= "List1(4)"
Tab(4).ControlCount= 1
TabCaption(5) = "交际"
TabPicture(5) = "FrmPyglxt.frx":76AD
Tab(5).ControlEnabled= 0 'False
Tab(5).Control(0)= "List1(5)"
Tab(5).ControlCount= 1
TabCaption(6) = "特长"
TabPicture(6) = "FrmPyglxt.frx":76C9
Tab(6).ControlEnabled= 0 'False
Tab(6).Control(0)= "List1(6)"
Tab(6).ControlCount= 1
TabCaption(7) = "存在问题"
TabPicture(7) = "FrmPyglxt.frx":76E5
Tab(7).ControlEnabled= 0 'False
Tab(7).Control(0)= "List1(7)"
Tab(7).ControlCount= 1
TabCaption(8) = "希望"
TabPicture(8) = "FrmPyglxt.frx":7701
Tab(8).ControlEnabled= 0 'False
Tab(8).Control(0)= "List1(8)"
Tab(8).ControlCount= 1
Begin VB.ListBox List1
Height = 3480
Index = 8
Left = -74760
TabIndex = 37
Top = 840
Width = 4815
End
Begin VB.ListBox List1
Height = 3480
Index = 7
Left = -74760
TabIndex = 36
Top = 840
Width = 4815
End
Begin VB.ListBox List1
Height = 3480
Index = 6
Left = -74760
TabIndex = 35
Top = 840
Width = 4815
End
Begin VB.ListBox List1
Height = 3480
Index = 5
Left = -74760
TabIndex = 34
Top = 840
Width = 4815
End
Begin VB.ListBox List1
Height = 3480
Index = 4
Left = -74760
TabIndex = 33
Top = 840
Width = 4815
End
Begin VB.ListBox List1
Height = 3480
Index = 3
Left = -74760
TabIndex = 32
Top = 840
Width = 4815
End
Begin VB.ListBox List1
Height = 3480
Index = 2
Left = -74760
TabIndex = 31
Top = 840
Width = 4815
End
Begin VB.ListBox List1
Height = 3480
Index = 1
Left = -74760
TabIndex = 30
Top = 840
Width = 4815
End
Begin VB.ListBox List1
Height = 3480
Index = 0
Left = 240
TabIndex = 29
Top = 840
Width = 4815
End
End
Begin VB.Label RSCount
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000040C0&
Height = 300
Left = 8160
TabIndex = 16
Top = 240
Width = 150
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "班级："
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 285
Left = 480
TabIndex = 15
Top = 210
Width = 900
End
End
Attribute VB_Name = "FrmPyglxt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RS0 As ADODB.Recordset
Dim RsPy As ADODB.Recordset
Dim RsPyadd As ADODB.Recordset
Dim AddFlg As Boolean
Private Sub CmdAdd_Click()
RtxPy.Text = " "
RtxJc.Text = ""
Combo1.Text = "优"
Combo2.Text = "请选择"
End Sub
Private Sub cmdCancel_Click()
If AddFlg = True Then
RsPyadd.CancelUpdate
RsPyadd.MoveNext
If RsPyadd.EOF Then RsPyadd.MoveLast
RtxPy.Text = ""
RtxJc.Text = ""
Else
RsPy.CancelBatch adAffectAllChapters
RsPy.MoveNext
If RsPy.EOF Then RsPy.MoveLast
End If
CmdAdd.Enabled = True
CmdMdi.Enabled = False
CmdDel.Enabled = False
CmdSave.Enabled = False
cmdCancel.Enabled = False
MuLst(Index).ListIndex = -1
End Sub
Private Sub CmdDel_Click()
If AddFlg = False Then
If vbYes = MsgBox("确认索要删除此记录么？", vbYesNo, "删除对话框") Then
RsPy.Delete
MuLst(Index).ListIndex = -1
RtxPy.Text = " "
RtxJc.Text = ""
Combo1.Text = "优"
Combo2.Text = "请选择"
CmdDel.Enabled = False
End If
End If
End Sub
Private Sub CmdSave_Click()
On Error GoTo err
If Trim(RtxPy.Text) = "" Then
MsgBox "请确认输入评语语句！"
Exit Sub
End If
If Trim(RtxJc.Text) = "" Then
MsgBox "请确认输入奖惩语句！"
Exit Sub
End If
If AddFlg = True Then
If Combo1.ListIndex = -1 Or Combo2.ListIndex = -1 Then
MsgBox "请确认选择操行等级和班主任！"
Exit Sub
End If
RsPyadd!姓名 = Trim(MuLst(Index).Text)
RsPyadd!评语 = "" & RtxPy.Text
RsPyadd!奖惩 = "" & RtxJc.Text
RsPyadd!操行等级 = Combo1.Text
RsPyadd!班主任 = Combo2.Text
RsPyadd.Update
RsPyadd.MoveNext
If RsPyadd.EOF Then RsPyadd.MoveLast
MsgBox "记录成功添加！"
Else
RsPy!姓名 = Trim(MuLst(Index).Text)
RsPy!评语 = "" & RtxPy.Text
RsPy!奖惩 = "" & RtxJc.Text
RsPy!操行等级 = Combo1.Text
RsPy!班主任 = Combo2.Text
RsPy.UpdateBatch adAffectAllChapters
MsgBox "记录成功修改！"
End If
CmdAdd.Enabled = True
CmdMdi.Enabled = False
CmdDel.Enabled = False
CmdSave.Enabled = False
cmdCancel.Enabled = False
MuLst(Index).ListIndex = -1
Combo1.Text = "优"
Combo2.Text = "请选择"
Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub
Private Sub ComBj_Click()
Dim txtSQL As String
Set RS0 = New ADODB.Recordset
RSCount.Caption = ""
If Trim(ComBj.Text) = "" Then
Else
txtSQL = "select * from 学籍表 where 班级 = '" & ComBj.Text & "'"
RS0.Open Trim$(txtSQL), Con, adOpenKeyset, adLockOptimistic
Set ExecuteSQL = RS0
For i = 0 To 7
MuLst(i).Clear
Next i
If RS0.EOF = True Then
RSCount.Caption = "本班现有" & RS0.RecordCount & "名学生！"
Else
RSCount.Caption = "本班现有" & RS0.RecordCount & "名学生！"
For rcount = 1 To RS0.RecordCount
MuLst(rcount \ 9).AddItem RS0!姓名
RS0.MoveNext
Next rcount
End If
End If
End Sub
Private Sub Command1_Click()
RtxPy.Text = RtxPy.Text & List1(SSTab1.Tab).Text
End Sub
Private Sub Form_Load()
Dim rsbj As ADODB.Recordset
Set rsbj = New ADODB.Recordset
rsbj.Open "班级表", Con, adOpenStatic, adLockPessimistic, adCmdTable
Set RsPyadd = New ADODB.Recordset
RsPyadd.Open "评语表", Con, adOpenStatic, adLockPessimistic, adCmdTable
ComBj.Clear
Combo2.Clear
Combo2.Text = "请选择"
Do While Not rsbj.EOF
ComBj.AddItem rsbj!班级
Combo2.AddItem rsbj!班主任
rsbj.MoveNext
Loop
If ComBj.ListCount > 0 Then
ComBj.ListIndex = 0
End If
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
For i = 0 To 8
rs.Open "select * from 评语词库表 where 类型 = '" & SSTab1.TabCaption(i) & "'", Con, adOpenStatic, adLockPessimistic, adCmdText
List1(i).Clear
Do While Not rs.EOF
List1(i).AddItem rs!词句
rs.MoveNext
Loop
rs.Close
Next i
End Sub
Private Sub MuLst_Click(Index As Integer)
If MuLst(Index).ListIndex > -1 Then
Set RsPy = New ADODB.Recordset
RsPy.Open "select * from 评语表 where 姓名 = '" & MuLst(Index).Text & "'", Con, adOpenStatic, adLockPessimistic, adCmdText
If RsPy.BOF = True And RsPy.EOF = True Then
If AddFlg = False Then
RtxPy.Text = " "
RtxJc.Text = ""
RtxPy.Text = RtxPy.Text & MuLst(Index).Text & "同学， "
Command1.Enabled = True
CmdDel.Enabled = False
CmdSave.Enabled = True
cmdCancel.Enabled = True
RsPyadd.AddNew
AddFlg = True
End If
Else
RtxPy.Text = RsPy!评语
RtxJc.Text = RsPy!奖惩
Combo1.Text = RsPy!操行等级
Combo2.Text = RsPy!班主任
Command1.Enabled = True
CmdDel.Enabled = True
CmdSave.Enabled = True
cmdCancel.Enabled = True
AddFlg = False
RsPyadd.CancelUpdate
RsPyadd.MoveNext
If RsPyadd.EOF Then RsPyadd.MoveLast
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -