📄 form2.frm
字号:
VERSION 5.00
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Object = "{CFA7AFF4-3242-4269-9172-7389D695AE01}#1.0#0"; "StoneXP.ocx"
Begin VB.Form Form2
BorderStyle = 1 'Fixed Single
Caption = "试题规划(比例分配窗口)"
ClientHeight = 3855
ClientLeft = 45
ClientTop = 435
ClientWidth = 9615
Icon = "Form2.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3855
ScaleWidth = 9615
StartUpPosition = 2 '屏幕中心
Begin StoneXP.XPButton XPButton8
Height = 375
Left = 1800
TabIndex = 9
Top = 3120
Width = 1215
_ExtentX = 2143
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ButtonStyle = 1
Caption = "计分分配"
MouseIcon = "Form2.frx":000C
MousePointer = 99
End
Begin StoneXP.XPButton XPButton1
Height = 375
Left = 8520
TabIndex = 1
Top = 600
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ButtonStyle = 1
Caption = "增加明细"
MouseIcon = "Form2.frx":0326
MousePointer = 99
End
Begin FlexCell.Grid Grid1
Height = 3000
Left = 0
TabIndex = 0
Top = 0
Width = 8415
_ExtentX = 14843
_ExtentY = 5292
Appearance = 0
Cols = 9
Rows = 11
ScrollBars = 2
End
Begin StoneXP.XPButton XPButton2
Height = 375
Left = 8520
TabIndex = 2
Top = 1080
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ButtonStyle = 1
Caption = "添加分配"
MouseIcon = "Form2.frx":0640
MousePointer = 99
End
Begin StoneXP.XPButton XPButton3
Height = 375
Left = 8520
TabIndex = 3
Top = 1560
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ButtonStyle = 1
Caption = "保 存"
MouseIcon = "Form2.frx":095A
MousePointer = 99
End
Begin StoneXP.XPButton XPButton4
Height = 375
Left = 8520
TabIndex = 4
Top = 2040
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ButtonStyle = 1
Caption = "修 改"
MouseIcon = "Form2.frx":0C74
MousePointer = 99
End
Begin StoneXP.XPButton XPButton5
Height = 375
Left = 8520
TabIndex = 5
Top = 2520
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ButtonStyle = 1
Caption = "删 除"
MouseIcon = "Form2.frx":0F8E
MousePointer = 99
End
Begin StoneXP.XPButton XPButton6
Height = 375
Left = 360
TabIndex = 6
Top = 3120
Width = 1335
_ExtentX = 2355
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ButtonStyle = 1
Caption = "使用此规则"
MouseIcon = "Form2.frx":12A8
MousePointer = 99
End
Begin StoneXP.XPButton XPButton7
Height = 375
Left = 8520
TabIndex = 8
Top = 120
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ButtonStyle = 1
Caption = "刷新"
MouseIcon = "Form2.frx":15C2
MousePointer = 99
End
Begin VB.Label Label1
Caption = "注：使用某规则时将鼠标选择表格中的行,点击《使用此规则》按钮或点击鼠标右键激活菜单选项进行选择"
ForeColor = &H000000FF&
Height = 255
Left = 120
TabIndex = 7
Top = 3600
Width = 8535
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim st_save As Boolean
Dim st_edit As Boolean
Dim st_del As Boolean
Dim st_gz As Boolean
Dim st_add As Boolean
Dim st_addmx As Boolean
Dim Rule_number(1000) As Long
Dim hang As Long
Private Sub Form_Load()
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
st_save = False
st_edit = True
st_del = True
st_addmx = False
st_gz = True
Grid1.ExtendLastCol = True
Grid1.BackColor1 = RGB(231, 235, 247)
Grid1.BackColor2 = RGB(198, 229, 211)
With Grid1 '这里设置图表控件grid1的一些参数
.AllowUserResizing = True '是否可调整行和例
.DisplayFocusRect = False '当前活动单元格是否显示一个虚框
'.ExtendLastCol = True '是否让表格充满控件
.Appearance = Flat '选择绘图风格，平面还是3D
.FixedRowColStyle = Flat '固定行/列的样式
.ScrollBarStyle = Flat '滚动条的样式
'以上几个都是关于grid1的美化设置，都是一些无关紧要的设置
.DefaultFont.Name = "Tahoma"
.DefaultFont.Size = 8
.BackColorFixed = RGB(84, 201, 134)
.BackColorFixedSel = RGB(167, 111, 177)
.BackColorBkg = RGB(198, 229, 211)
.BackColorScrollBar = RGB(167, 111, 177)
.BackColor1 = RGB(231, 235, 247)
.BackColor2 = RGB(198, 229, 211)
.GridColor = RGB(148, 190, 231)
.Column(0).Width = 0
End With
For i = 1 To Grid1.Cols - 1
Grid1.Column(i).Width = 70
If i <> 1 Then
Grid1.Column(i).Mask = cellValue
Grid1.Column(i).DecimalLength = 0
End If
Next
Set qy1 = cnn.Execute("select * from 试题设置")
For i = 0 To qy1.Fields.Count - 2
Set qy2 = cnn.Execute("select 单题分数 from 分数 where 题型='" & qy1.Fields(i).Name & "'")
If qy2.EOF = True Then '题型不配对时只显示名称
Grid1.Cell(0, i + 1).Text = qy1.Fields(i).Name
Else
Grid1.Cell(0, i + 1).Text = qy1.Fields(i).Name & "(" & qy2.Fields(0) & "分)"
Feng_st(i) = qy2.Fields(0)
End If
Next
Grid1.Cell(0, Grid1.Cols - 1).Text = Grid1.Cell(0, Grid1.Cols - 1).Text & "(分钟)"
'将获取的各种题型分数输出到各变量,以后后面的引用
Feng_xz = Feng_st(1)
Feng_tk = Feng_st(2)
Feng_dc = Feng_st(3)
Feng_jd = Feng_st(4)
Feng_wd = Feng_st(5)
grid1see_all
End Sub
Private Sub grid1see_all()
st_add = False
Grid1.Rows = 1
Do While Not qy1.EOF
Grid1.Rows = Grid1.Rows + 1
For i = 1 To Grid1.Cols - 1
Grid1.Cell(Grid1.Rows - 1, i).Text = qy1.Fields(i - 1)
Next
'使用编号赋值方式进行操作,可以实现方便的删除与修改操作
Rule_number(Grid1.Rows - 1) = qy1.Fields(qy1.Fields.Count - 1)
qy1.MoveNext
Loop
st_add = True
st_del = True
st_edit = True
End Sub
Private Sub Grid1_CellChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
If Row >= 1 And Col < 7 Then
'刷新第5列相关的单元格
Grid1.Cell(Row, 7).Refresh
End If
End Sub
Private Sub Grid1_GetCellText(ByVal Row As Long, ByVal Col As Long, Text As String, Changed As Boolean)
If Row >= 1 And Row <= Grid1.Rows - 1 And Col = 7 Then
Text = Grid1.Cell(Row, 2).LongValue * Feng_st(1) + Grid1.Cell(Row, 3).LongValue * Feng_st(2) + Grid1.Cell(Row, 4).LongValue * Feng_st(3) + Grid1.Cell(Row, 5).LongValue * Feng_st(4) + Grid1.Cell(Row, 6).LongValue * Feng_st(5)
Changed = True
End If
End Sub
Private Sub XPButton1_Click()
If st_addmx = True Then
st_add = False
Grid1.Rows = Grid1.Rows + 1
st_add = True
Else
MsgBox "目前不允许执行此操作！"
End If
End Sub
Private Sub XPButton2_Click()
Grid1.Rows = 1
Grid1.Rows = Grid1.Rows + 1
st_save = True
st_edit = False
st_del = False
st_addmx = True
st_gz = False
End Sub
Private Sub XPButton3_Click()
On Error GoTo finish:
Dim sql As String
If st_save = True Then
Else
MsgBox "当前状态不支持保存！"
End If
For i = Grid1.Rows - 1 To 1 Step -1
Set qy2 = cnn.Execute("select * from 试题设置 where 规则='" & Grid1.Cell(i, 1).Text & "'")
If qy2.EOF = False Then
MsgBox "此规则名已存在(" & Grid1.Cell(i, 1).Text & ")"
Exit Sub
End If
sql = "insert into 试题设置("
For j = 1 To Grid1.Cols - 2
sql = sql & qy1.Fields(j - 1).Name & ","
Next
sql = sql & qy1.Fields(qy1.Fields.Count - 2).Name & ") values('"
sql = sql & Grid1.Cell(i, 1).Text & "',"
For j = 2 To Grid1.Cols - 2
sql = sql & Grid1.Cell(i, j).Text & ","
Next
sql = sql & Grid1.Cell(i, Grid1.Cols - 1).Text & ")"
MsgBox sql
Set qy2 = cnn.Execute(sql)
Grid1.RemoveItem (i)
Next
MsgBox "已完成保存！"
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub XPButton4_Click()
If st_edit = False Then
MsgBox "非修改状态!"
Exit Sub
End If
For i = 1 To Grid1.Rows - 1
sql = "update 试题设置 set " & qy1.Fields(0).Name & "='" & Grid1.Cell(i, 1).Text & "'"
For j = 2 To Grid1.Cols - 1
sql = sql & "," & qy1.Fields(j - 1).Name & "=" & Grid1.Cell(i, j).Text
Next
sql = sql & " where 编号=" & Rule_number(i)
Next
Set qy1 = cnn.Execute(sql)
MsgBox "已完成修改!"
End Sub
Private Sub XPButton5_Click()
MsgBox hang
If hang <> 0 And st_del = True Then
sql = "delete from 试题设置 where 编号=" & Rule_number(hang)
Set qy1 = cnn.Execute(sql)
MsgBox "已成功删除指定记录！"
Else
MsgBox "非删除状态或鼠标指向目录行."
End If
End Sub
Private Sub XPButton6_Click()
Unload Me
load_stnumber
Form1.load_strule '加载试题规则
Form1.load_feng '加载分数分配表
End Sub
Private Sub XPButton7_Click()
Set qy1 = cnn.Execute("select * from 试题设置")
grid1see_all
End Sub
Private Sub XPButton8_Click()
Unload Me
form3.Show 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -