?? frmshijuan.frm
字號:
_ExtentX = 10292
_ExtentY = 8520
_Version = 393217
BackColor = 15267064
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 2
Appearance = 0
TextRTF = $"FrmShiJuan.frx":0573
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Begin VB.Frame Frame3
BackColor = &H00FFFF80&
Height = 6690
Left = 180
TabIndex = 11
Top = 165
Width = 2535
Begin MSComctlLib.ImageList ImgKemu
Left = 1785
Top = 5190
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmShiJuan.frx":0610
Key = "question"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmShiJuan.frx":0A62
Key = "zonglei"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmShiJuan.frx":0EB4
Key = "zilei"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmShiJuan.frx":1306
Key = "nandu"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmShiJuan.frx":1758
Key = "nanduopen"
EndProperty
EndProperty
End
Begin MSComctlLib.TreeView TrVKeMu
Height = 6390
Left = 90
TabIndex = 12
ToolTipText = "雙擊加入所選中的題目"
Top = 210
Width = 2310
_ExtentX = 4075
_ExtentY = 11271
_Version = 393217
Indentation = 460
LabelEdit = 1
LineStyle = 1
Style = 7
ImageList = "ImgKemu"
BorderStyle = 1
Appearance = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
End
Begin VB.Label Label1
BackColor = &H00FFFF80&
Caption = "試卷標題："
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 270
Left = 2220
TabIndex = 96
Top = 75
Width = 1200
End
End
Attribute VB_Name = "FrmShiJuan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public LstWho As String '表示對那個list框改變分數
Dim Who As Integer ' 'who表示的是現在編輯的題型的序號
Function CreateTest() As Boolean '生成試卷
CreateTest = False
If LstTM.ListCount < 1 And LstTMD.ListCount < 1 And LstTKT.ListCount < 1 And LstPDT.ListCount < 1 And LstWDT.ListCount < 1 And LstZWT.ListCount < 1 Then
MsgBox "請至少選擇一種題型！"
Exit Function
End If
'生成試卷
If TXTTitle.Text = "" Then
MsgBox "<試卷標題> 是必填項！", vbExclamation, "系統提示"
TXTTitle.SetFocus
Exit Function
End If
Dim Danxuan As String '單選題
Dim Duoxuan As String '多選題
Dim Danxuans As String '單選分數
Dim Duoxuans As String '多選分數
'Dim TianKong As String '填空題
'Dim TianKongs As String '填空題分數
'Dim PanDuan As String '判斷題
'Dim PanDuans As String '判斷題分數
'Dim WenDa As String '問答題
'Dim WenDas As String '問答題分數
'Dim ZuoWen As String '作文題
'Dim ZuoWens As String '作文題分數
Dim i, j As Integer
Dim TempArr() As String
Dim Zscore As Single
'單選
Danxuans = ""
If LstTM.ListCount <> 0 Then
For i = 0 To LstTM.ListCount - 1
TempArr = Split(LstTM.List(i), "(")
Danxuan = Danxuan + TempArr(0) + ","
Danxuans = Danxuans + "1,"
Zscore = Zscore + 1
' Danxuans = Danxuans + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
' Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
Next i
Else
Danxuan = ","
Danxuans = ","
End If
'多選
Duoxuans = ""
If LstTMD.ListCount <> 0 Then
For i = 0 To LstTMD.ListCount - 1
TempArr = Split(LstTMD.List(i), "(")
Duoxuan = Duoxuan + TempArr(0) + ","
Duoxuans = Duoxuans + "2,"
Zscore = Zscore + 2
' Duoxuans = Duoxuans + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
' Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
Next i
Else
Duoxuan = ","
Duoxuans = ","
End If
''填空
'If LstTKT.ListCount <> 0 Then
' For i = 0 To LstTKT.ListCount - 1
' TempArr = Split(LstTKT.List(i), "(")
' TianKong = TianKong + TempArr(0) + ","
' TianKongs = TianKongs + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
' Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
' Next i
'Else
' TianKong = ","
' TianKongs = ","
'End If
''判斷
'If LstPDT.ListCount <> 0 Then
' For i = 0 To LstPDT.ListCount - 1
' TempArr = Split(LstPDT.List(i), "(")
' PanDuan = PanDuan + TempArr(0) + ","
' PanDuans = PanDuans + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
' Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
' Next i
'Else
' PanDuan = ","
' PanDuans = ","
'End If
''問答
'If LstWDT.ListCount <> 0 Then
' For i = 0 To LstWDT.ListCount - 1
' TempArr = Split(LstWDT.List(i), "(")
' WenDa = WenDa + TempArr(0) + ","
' WenDas = WenDas + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
' Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
' Next i
'Else
' WenDa = ","
' WenDas = ","
'End If
''作文
'If LstZWT.ListCount <> 0 Then
' For i = 0 To LstZWT.ListCount - 1
' TempArr = Split(LstZWT.List(i), "(")
' ZuoWen = ZuoWen + TempArr(0) + ","
' ZuoWens = ZuoWens + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
' Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
' Next i
'Else
' ZuoWen = ","
' ZuoWens = ","
'End If
Danxuan = Left(Danxuan, Len(Danxuan) - 1)
Danxuans = Left(Danxuans, Len(Danxuans) - 1)
Duoxuan = Left(Duoxuan, Len(Duoxuan) - 1)
Duoxuans = Left(Duoxuans, Len(Duoxuans) - 1)
'TianKong = Left(TianKong, Len(TianKong) - 1)
'TianKongs = Left(TianKongs, Len(TianKongs) - 1)
'PanDuan = Left(PanDuan, Len(PanDuan) - 1)
'PanDuans = Left(PanDuans, Len(PanDuans) - 1)
'
'WenDa = Left(WenDa, Len(WenDa) - 1)
'WenDas = Left(WenDas, Len(WenDas) - 1)
'ZuoWen = Left(ZuoWen, Len(ZuoWen) - 1)
'ZuoWens = Left(ZuoWens, Len(ZuoWens) - 1)
Dim Msg As String
Msg = Msg + CStr(LstTM.ListCount) + "道單選擇題," + " 分數：" + CStr(LstTM.ListCount) + vbCrLf
Msg = Msg + CStr(LstTMD.ListCount) + "道多選擇題," + " 分數：" + CStr(2 * LstTMD.ListCount) + vbCrLf
'Msg = Msg + "填空題：" + tiankong + " 分數：" + tiankongs + vbCrLf
'Msg = Msg + "填空題：" + panduan + " 分數：" + panduans + vbCrLf
'Msg = Msg + "問答題：" + wenda + " 分數：" + wendas + vbCrLf
'Msg = Msg + "作文題：" + zuowen + " 分數：" + zuowens + vbCrLf
Msg = Msg + "試卷總分數為：" & Zscore
MsgBox Msg
'寫入數據庫
If MsgBox("你真的要生成這份試卷嗎？確認嗎？", vbYesNo, "問題") = vbNo Then
Exit Function
End If
Dim testRS As Recordset
Set testRS = New Recordset
testRS.Open "test", adoCn, adOpenStatic, adLockOptimistic
testRS.AddNew
testRS.Fields("id") = GetAutoID("test")
testRS.Fields("kemuid") = UseKeMuID
testRS.Fields("nianjiid") = UseNianJiID
testRS.Fields("title") = TXTTitle.Text
testRS.Fields("danxuan") = Danxuan
testRS.Fields("duoxuan") = Duoxuan
testRS.Fields("danxuans") = Danxuans
testRS.Fields("duoxuans") = Duoxuans
'testRS.Fields("tiankong") = TianKong
'testRS.Fields("tiankongs") = TianKongs
'testRS.Fields("panduan") = PanDuan
'testRS.Fields("panduans") = PanDuans
'testRS.Fields("wenda") = WenDa
'testRS.Fields("wendas") = WenDas
'testRS.Fields("zuowen") = ZuoWen
'testRS.Fields("zuowens") = ZuoWens
testRS.Fields("zscore").Value = Zscore
testRS.Update
MsgBox "試卷已經成功的生成！"
TXTTitle.Text = ""
CreateTest = True
End Function
Private Sub Check1_Click()
End Sub
'Private Sub CmbPD_Click()
' Dim adoRs As Recordset
' Dim NanDuStr As String
' Set adoRs = New Recordset
' '查詢題目id
' NanDuStr = CmbPD.Text
' If CmbPD.ListIndex <> 0 Then
' adoRs.Open "select id from questionPD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID & " and nandu='" & NanDuStr & "'", adoCn, adOpenStatic, adLockOptimistic
' Else
' adoRs.Open "select id from questionPD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
' End If
' LstPD.Clear
' '添加列表
' Do While Not adoRs.EOF
' LstPD.AddItem "第" & adoRs.Fields("id").Value & "題"
' adoRs.MoveNext
' Loop
' Set adoRs = Nothing
'End Sub
'Private Sub CmbTK_Click()
' Dim adoRs As Recordset
' Dim NanDuStr As String
' Set adoRs = New Recordset
' '查詢題目id
' NanDuStr = CmbTK.Text
' If CmbTK.ListIndex <> 0 Then
' adoRs.Open "select id from questionTK where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID & " and nandu='" & NanDuStr & "'", adoCn, adOpenStatic, adLockOptimistic
' Else
' adoRs.Open "select id from questionTK where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
' End If
' LstTK.Clear
' '添加列表
' Do While Not adoRs.EOF
' LstTK.AddItem "第" & adoRs.Fields("id").Value & "題"
' adoRs.MoveNext
' Loop
' Set adoRs = Nothing
'
'End Sub
'Private Sub CmbWD_Click()
' Dim adoRs As Recordset
' Dim NanDuStr As String
' Set adoRs = New Recordset
' '查詢題目id
' NanDuStr = CmbWD.Text
' If CmbWD.ListIndex <> 0 Then
' adoRs.Open "select id from questionWD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID & " and nandu='" & NanDuStr & "'", adoCn, adOpenStatic, adLockOptimistic
' Else
' adoRs.Open "select id from questionWD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
' End If
' LstWD.Clear
' '添加列表
' Do While Not adoRs.EOF
' LstWD.AddItem "第" & adoRs.Fields("id").Value & "題"
' adoRs.MoveNext
' Loop
' Set adoRs = Nothing
'End Sub
'Private Sub CmbZW_Click()
' Dim adoRs As Recordset
' Dim NanDuStr As String
' Set adoRs = New Recordset
' '查詢題目id
' NanDuStr = CmbZW.Text
' If ?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -