📄 frmprize.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form FrmPrize
BorderStyle = 3 'Fixed Dialog
Caption = "学生奖励管理"
ClientHeight = 6255
ClientLeft = 45
ClientTop = 435
ClientWidth = 10275
Icon = "FrmPrize.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6255
ScaleWidth = 10275
ShowInTaskbar = 0 'False
Begin MSComctlLib.ImageList ImageList1
Left = 2760
Top = 1260
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483628
ImageWidth = 16
ImageHeight = 16
MaskColor = 16777215
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmPrize.frx":06EA
Key = "imgGlobalFolder"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmPrize.frx":307C
Key = "imgClosedFolder"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmPrize.frx":3416
Key = "imgOpenedFolder"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmPrize.frx":37B0
Key = "imgDeselectedFile"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmPrize.frx":3B4A
Key = "imgSelectedFile"
EndProperty
EndProperty
End
Begin VB.CommandButton cmdClose
Cancel = -1 'True
Caption = "关闭"
Height = 400
Left = 8460
TabIndex = 4
Top = 5580
Width = 1275
End
Begin VB.CommandButton cmdDel
Caption = "删除"
Height = 400
Left = 6840
TabIndex = 3
Top = 5580
Width = 1275
End
Begin VB.CommandButton cmdEdit
Caption = "修改"
Height = 400
Left = 5220
TabIndex = 2
Top = 5580
Width = 1275
End
Begin VB.CommandButton cmdAdd
Caption = "添加"
Height = 400
Left = 3600
TabIndex = 1
Top = 5580
Width = 1275
End
Begin MSComctlLib.TreeView TreeView1
Height = 2355
Left = 120
TabIndex = 0
Top = 120
Width = 2895
_ExtentX = 5106
_ExtentY = 4154
_Version = 393217
HideSelection = 0 'False
LabelEdit = 1
Style = 7
ImageList = "ImageList1"
Appearance = 1
End
Begin MSDataGridLib.DataGrid DataGrid1
Height = 5295
Left = 3180
TabIndex = 5
Top = 120
Width = 6975
_ExtentX = 12303
_ExtentY = 9340
_Version = 393216
AllowUpdate = 0 'False
HeadLines = 1
RowHeight = 15
FormatLocked = -1 'True
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 4
BeginProperty Column00
DataField = "StuName"
Caption = "学生姓名"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = "PDate"
Caption = "奖励日期"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column02
DataField = "PReason"
Caption = "奖励原因"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column03
DataField = "PDetail"
Caption = "详细说明"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
ColumnWidth = 959.811
EndProperty
BeginProperty Column01
ColumnWidth = 1049.953
EndProperty
BeginProperty Column02
ColumnWidth = 1560.189
EndProperty
BeginProperty Column03
ColumnWidth = 2819.906
EndProperty
EndProperty
End
Begin MSComctlLib.ListView ListView1
Height = 3435
Left = 120
TabIndex = 6
Top = 2640
Width = 2895
_ExtentX = 5106
_ExtentY = 6059
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Attribute VB_Name = "FrmPrize"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public rsPrize As New ADODB.Recordset '声明学生奖励信息记录集
Private Sub Form_Load()
Dim TmpNode As Node
'加入根结点（学校）
Set TmpNode = TreeView1.Nodes.Add(, , "a0", "长沙环境保护职业技术学院", "imgGlobalFolder")
TmpNode.Selected = True
TmpNode.Expanded = True
TreeView1.LabelEdit = tvwManual
TreeView1.HideSelection = False
'设置ListView控件列（增加列标题，显示格式等）
ListView1.ColumnHeaders.Add , , "学号", ListView1.Width / 2
ListView1.ColumnHeaders.Add , , "姓名", ListView1.Width / 2
ListView1.View = lvwReport '设置外观为报表样式
ListView1.LabelEdit = lvwManual
ListView1.FullRowSelect = True
ListView1.HideSelection = False
'调用通用函数将所有班级或院系添加到TreeView1中
Call Add_ClassToTree(TreeView1, "a0")
Call TreeView1_Click
DataGrid1.AllowUpdate = False '初始化DataGrid控件
Left = 0
Top = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
If rsPrize.State = adStateOpen Then rsPrize.Close
Set rsPrize = Nothing
Set FrmPrize = Nothing
End Sub
Private Sub TreeView1_Click()
Dim sClassID As String
Dim strSql As String
Dim Rs As New ADODB.Recordset
Dim itmX As ListItem
Dim Tmp_Key As String
ListView1.ListItems.Clear
sClassID = Right(TreeView1.SelectedItem.Key, Len(TreeView1.SelectedItem.Key) - 1)
strSql = "SELECT StuID, StuNo, StuName FROM students " & _
"WHERE ClassId='" & sClassID & "' order by StuNo"
Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
If Rs.RecordCount > 0 Then
'添加默认<全部>项（关键字为"b0"），可用来显示该班所有学生的奖励信息
Set itmX = ListView1.ListItems.Add(, "b0", "<全部>")
'遍历该班级所有学生，将学生数据加入ListView1中
Do Until Rs.EOF
Tmp_Key = "b" & Rs!StuID
Set itmX = ListView1.ListItems.Add(, Tmp_Key, Rs!StuNo)
itmX.SubItems(1) = Rs!StuName
Rs.MoveNext
Loop
End If
Rs.Close
Set Rs = Nothing
'如果该班级存在学生，选中ListView中第1项，并显示相应的奖励记录；
'如果不存在学生，采用top 0获得空的记录集，使奖励记录显示为空
If ListView1.ListItems.Count > 0 Then
ListView1.SelectedItem.Selected = True
Call ListView1_Click
Else
'如果rsPrize对象已打开，则先关闭
If rsPrize.State = adStateOpen Then rsPrize.Close
'控制DataGrid1中显示为空
strSql = "select top 0 Prize.*,students.StuNo,StuName from Prize,students " & _
"where Prize.StuID=students.StuID"
rsPrize.Open strSql, Conn, adOpenStatic, adLockBatchOptimistic '批更新模式
'批更新模式：更新本记录集时，仅影响本记录集本身以及关联DataGrid的显示，
'不会自动影响本记录集所涉及的数据表，除非调用记录集的UpdateBatch方法，
'对于涉及到多表查询的记录集的更新，可采用这种模式，具体见增/删/改的操作
Set DataGrid1.DataSource = rsPrize '记录集与DataGrid控件进行关联
End If
End Sub
Private Sub ListView1_Click()
Dim sClassID As String
Dim sStuID As String
Dim strSql As String
If ListView1.ListItems.Count > 0 Then
'获取班级内码
sClassID = Right(TreeView1.SelectedItem.Key, Len(TreeView1.SelectedItem.Key) - 1)
'获取学生内码（如果为0，则表示选择的是<全部>项）
sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
If sStuID = "0" Then '选择<全部>项
'查询该班级所有学生的奖励信息（以学号、日期排序）
strSql = "select Prize.*,students.StuNo,StuName from Prize,students " & _
"where Prize.StuID=students.StuID and students.ClassID='" & _
sClassID & "' order by students.StuNo,Prize.PDate DESC"
Else
'查询某一个学生的奖励信息
strSql = "select Prize.*,students.StuNo,StuName from Prize,students " & _
"where Prize.StuID=students.StuID and students.StuID='" & _
sStuID & "' order by students.StuNo,Prize.PDate DESC"
End If
'如果rsPrize对象已打开，则先关闭
If rsPrize.State = adStateOpen Then rsPrize.Close
'重新打开
rsPrize.Open strSql, Conn, adOpenStatic, adLockBatchOptimistic '批更新模式
Set DataGrid1.DataSource = rsPrize
End If
End Sub
Private Sub cmdAdd_Click()
Dim sStuID As String
If ListView1.ListItems.Count = 0 Then
MsgBox "没有学生记录", vbExclamation + vbOKOnly, "操作提示"
Exit Sub
End If
sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
If sStuID = "0" Then '选择<全部>项
MsgBox "请选择一个学生", vbExclamation + vbOKOnly, "操作提示"
Exit Sub
End If
ModifyFlag = 0 '以添加记录方式，打开奖励信息编辑窗体
FrmPrizeUpdate.Show 1
End Sub
Private Sub cmdEdit_Click()
If rsPrize.RecordCount = 0 Then
MsgBox "没有可修改的记录", vbExclamation + vbOKOnly, "操作提示"
Exit Sub
End If
ModifyFlag = 1 ''以修改记录方式，打开奖励信息编辑窗体
FrmPrizeUpdate.Show 1
End Sub
Private Sub cmdDel_Click()
On Error GoTo ErrorHandle
Dim blnState As Boolean '标志变量：True-事务未全部完成，False-全部完成
If rsPrize.RecordCount = 0 Then
MsgBox "没有可删除的记录", vbExclamation + vbOKOnly, "操作提示"
Exit Sub
End If
'确认删除
If MsgBox("确实要删除当前记录吗？", _
vbQuestion + vbYesNo, "操作提示") = vbNo Then
Exit Sub
End If
Conn.BeginTrans '开始事务
blnState = True '设置标志状态
'正式删除
'使用连接对象从Prize表中删除当前奖励记录
Conn.Execute "delete from Prize where ID='" & rsPrize!ID & "'"
'同时把当前记录从RsPrize记录集中删除，以便不在DataGrid控件上显示出来
'rsPrize是批更新模式，记录集的删除不会影响到所涉及的数据表中的数据
rsPrize.Delete
Conn.CommitTrans '提交事务
blnState = False '取消标志状态
'如果删除后还存在记录，移动到下一条；若已经到底，则移到最后一条记录上
If rsPrize.RecordCount > 0 Then
rsPrize.MoveNext
If rsPrize.EOF Then
rsPrize.MoveLast
End If
End If
On Error GoTo 0
Exit Sub
ErrorHandle:
If blnState = True Then Conn.RollbackTrans '在事务中发生错误，回滚事务
MsgBox Error(Err.Number), vbExclamation + vbOKOnly, "操作提示"
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -