📄 frmseachcj.frm
字号:
BackColor = &H8000000A&
Caption = "加入"
ForeColor = &H80000008&
Height = 195
Left = 6420
TabIndex = 1
Top = 330
Width = 660
End
Begin MSComCtl2.DTPicker DTPS
Height = 315
Left = 7980
TabIndex = 3
Top = 240
Width = 1440
_ExtentX = 2540
_ExtentY = 556
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 24903681
CurrentDate = 37024
End
Begin MSComCtl2.UpDown UDScore
Height = 315
Left = 1965
TabIndex = 4
Top = 750
Width = 270
_ExtentX = 476
_ExtentY = 556
_Version = 393216
BuddyControl = "TXTScore"
BuddyDispid = 196625
OrigLeft = 1995
OrigTop = 705
OrigRight = 2265
OrigBottom = 1020
Max = 300
SyncBuddy = -1 'True
BuddyProperty = 0
Enabled = -1 'True
End
Begin MSComCtl2.DTPicker DTPE
Height = 315
Left = 9690
TabIndex = 9
Top = 255
Width = 1440
_ExtentX = 2540
_ExtentY = 556
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 24903681
CurrentDate = 37024
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "科目:"
ForeColor = &H00000000&
Height = 180
Left = 180
TabIndex = 25
Top = 1440
Width = 450
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "年级:"
ForeColor = &H00000000&
Height = 180
Left = 2310
TabIndex = 24
Top = 1440
Width = 450
End
Begin VB.Label Label3
Caption = "考生姓名(支持模糊查询)："
Height = 165
Left = 1965
TabIndex = 16
Top = 315
Width = 2160
End
Begin VB.Label Label1
Caption = "试卷ID："
Height = 165
Index = 9
Left = 150
TabIndex = 15
Top = 345
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "成绩："
Height = 180
Index = 0
Left = 150
TabIndex = 14
Top = 825
Width = 540
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "考试日期"
Height = 180
Index = 0
Left = 7200
TabIndex = 13
Top = 330
Width = 720
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "到"
Height = 180
Index = 1
Left = 9465
TabIndex = 12
Top = 315
Width = 180
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "试卷标题(支持模糊查询)"
Height = 180
Index = 1
Left = 2895
TabIndex = 11
Top = 735
Width = 1980
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "( )"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 6330
TabIndex = 10
Top = 315
Width = 840
End
End
End
Attribute VB_Name = "FrmSeachCJ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim KeMuIdArr() As Long '科目id数组
Dim NianJiIdArr() As Long
Private Sub CmdDel_Click()
If CheDel.Value <> 1 Then
'删除单个成绩
If DGScore.Row < 0 Then
MsgBox "你没有选择你要删除的成绩！"
Else
If MsgBox("这是一个很危险的动作，你会删除所查询的同学的成绩，你确定吗？", vbYesNo + 48, "提示！") = vbYes Then
DB.Execute "delete from score where id=" & DGScore.Columns(8).Text
DB.Execute "delete from scoreTK where id=" & DGScore.Columns(8).Text
DB.Execute "delete from scorePD where id=" & DGScore.Columns(8).Text
DB.Execute "delete from scoreWD where id=" & DGScore.Columns(8).Text
DB.Execute "delete from scoreZW where id=" & DGScore.Columns(8).Text
Command2_Click
End If
End If
End If
End Sub
Private Sub Command1_Click()
Dim IdStr As Long
If DGScore.ApproxCount <= 0 Or DGScore.Row < 0 Then
MsgBox "你没有选择要查看的试卷！"
Exit Sub
End If
IdStr = Val(DGScore.Columns(8).Text)
CreateScoreHTML App.Path + "\temp.html", IdStr
FrmView.Web.Navigate App.Path + "\temp.html"
FrmView.Show 1
End Sub
'得到查询条件的字符串
Function GetTJStr() As String
'定义查询条件,保存各个查询条件
Dim SqlTID As String
Dim SqlName As String
Dim SqlScore As String
Dim SqlTitle As String
Dim SqlDay As String
Dim SqlKeMu As String
Dim SqlNianJi As String
Dim SqlBan As String
'设置试卷编号查询条件
If TXTtestID.Text <> "" Then
SqlTID = " and score.testid=" + TXTtestID.Text
Else
SqlTID = ""
End If
'设置姓名关键字
If TXTSname.Text <> "" Then
SqlName = " and kaosheng.name like '%" + TXTSname.Text + "%'"
Else
SqlName = ""
End If
'设置试卷标题
If TxTTitle.Text <> "" Then
SqlTitle = " and test.title like '%" + TxTTitle.Text + "%'"
Else
SqlTitle = ""
End If
'设置分数
If TXTScore.Text <> "" Then
SqlScore = " and score.score" + CmbCZS.Text + TXTScore.Text
Else
SqlScore = ""
End If
'设置考试日期
If CheDay.Value = 1 Then
SqlDay = " and score.testtime>='" + Date2Str(DTPS.Value) + "' and score.testtime<='" + Date2Str(DTPE.Value) + "'"
Else
SqlDay = ""
End If
'设置年级
If CmbNianji.ListIndex = 0 Then
SqlNianJi = ""
Else
SqlNianJi = " and test.nianjiid=" & NianJiIdArr(CmbNianji.ListIndex - 1)
End If
'设置科目
If CmbKeMu.ListIndex = 0 Then
SqlKeMu = ""
Else
SqlKeMu = " and test.kemuid=" & KeMuIdArr(CmbKeMu.ListIndex - 1)
End If
'设置班级
If CheBan.Value = 1 Then
SqlBan = " and kaosheng.class=" & TXTBan.Text
Else
SqlBan = ""
End If
GetTJStr = SqlDay + SqlTID + SqlName + SqlTitle + SqlScore + SqlKeMu + SqlNianJi + SqlBan
End Function
Private Sub Command2_Click()
Dim adoRs As Recordset
Dim sql As String
Set adoRs = New Recordset
'==========================================
sql = "select kaosheng.code as 学号,kaosheng.name as 考生姓名,score.testid as 试卷编号,test.title as 试卷标题,score.score as 考试成绩,test.zscore as 试卷总分,kemu.name as 科目,score.testtime as 考试时间,score.id as ID值 from score,kaosheng,test,kemu where kemu.id=test.kemuid and score.studentid=kaosheng.id and test.id=score.testid"
sql = sql + GetTJStr '得到条件字符串函数
adoRs.Open sql, DB, adOpenStatic, adLockOptimistic
Set DGScore.DataSource = adoRs
End Sub
Function Date2Str(ByVal DT As Date) As String '日期转化成字符
Dim DateStr As String
DateStr = Format(DT, "YYYY-MM-DD")
Date2Str = DateStr
End Function
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
Dim adoRs As Recordset
Dim sql As String
Set adoRs = New Recordset
'==========================================
sql = "select kaosheng.code as 学号,kaosheng.name as 考生姓名,score.testid as 试卷编号,test.title as 试卷标题,score.score as 考试成绩,test.zscore as 试卷总分,kemu.name as 科目,score.testtime as 考试时间,score.id as ID值 from score,kaosheng,test,kemu where kemu.id=test.kemuid and score.studentid=kaosheng.id and test.id=score.testid"
sql = sql + GetTJStr + " order by score.score desc" '得到条件字符串函数
adoRs.Open sql, DB, adOpenStatic, adLockOptimistic
Set DGScore.DataSource = adoRs
If adoRs.EOF Then
MsgBox "你的查询结果为空，最好选择以年级、班或科目为单位查询！"
Exit Sub
End If
CreateScoreTable App.Path + "\temp.html", adoRs
FrmView.Web.Navigate App.Path + "\temp.html"
FrmView.Show 1
End Sub
Private Sub Form_Load()
CmbCZS.ListIndex = 0
'显示所有成绩表
Dim adoScoreRS As Recordset
Dim i As Integer
Set adoScoreRS = New Recordset
Dim adoRs As Recordset
Set adoRs = New Recordset
On Error Resume Next
'组合考生表查询
adoScoreRS.Open "select kaosheng.code as 学号,kaosheng.name as 考生姓名,score.testid as 试卷编号,test.title as 试卷标题,score.score as 考试成绩,test.zscore as 试卷总分,kemu.name as 科目,score.testtime as 考试时间,score.id as ID值 from score,kaosheng,test,kemu where kemu.id=test.kemuid and score.studentid=kaosheng.id and test.id=score.testid", DB, adOpenStatic, adLockOptimistic
Set DGScore.DataSource = adoScoreRS
'年级
adoRs.Open "select id,name from nianji", DB, adOpenStatic, adLockOptimistic
CmbNianji.AddItem "所有年级"
If Not adoRs.EOF Then
adoRs.MoveLast
adoRs.MoveFirst
ReDim NianJiIdArr(adoRs.RecordCount) As Long
For i = 0 To adoRs.RecordCount - 1
CmbNianji.AddItem adoRs.Fields("name").Value
NianJiIdArr(i) = adoRs.Fields("id").Value
adoRs.MoveNext
Next i
End If
adoRs.Close
'科目
adoRs.Open "kemu", DB, adOpenStatic, adLockOptimistic
CmbKeMu.AddItem "所有科目"
If Not adoRs.EOF Then
adoRs.MoveLast
adoRs.MoveFirst
ReDim KeMuIdArr(adoRs.RecordCount) As Long
For i = 0 To adoRs.RecordCount - 1
CmbKeMu.AddItem adoRs.Fields("name").Value
KeMuIdArr(i) = adoRs.Fields("id").Value
adoRs.MoveNext
Next i
End If
Set adoRs = Nothing
CmbKeMu.ListIndex = 0
CmbNianji.ListIndex = 0
End Sub
Private Sub TXTScore_KeyPress(KeyAscii As Integer)
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 46) Then
KeyAscii = 0
End If
End Sub
Private Sub TXTSname_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = -24145
End Sub
Private Sub TXTtestID_KeyPress(KeyAscii As Integer)
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 46) Then
KeyAscii = 0
End If
End Sub
Private Sub TxTTitle_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = -24145
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -