📄 frmin.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form Frmin
BackColor = &H00008000&
Caption = "输入考试班级和监考教师"
ClientHeight = 6840
ClientLeft = 60
ClientTop = 630
ClientWidth = 9840
ControlBox = 0 'False
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6840
ScaleWidth = 9840
WindowState = 1 'Minimized
Begin MSComDlg.CommonDialog DialogPath
Left = 9360
Top = 5880
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command5
Caption = "从排课文件导入..."
Height = 375
Left = 7200
TabIndex = 19
Top = 6360
Width = 2175
End
Begin VB.Frame Frame2
BackColor = &H00008000&
Caption = "输入监考教师及其任教情况"
Height = 5940
Left = 4680
TabIndex = 6
Top = 285
Width = 4935
Begin VB.CommandButton Command7
Caption = "不定"
Height = 270
Left = 4020
TabIndex = 18
Top = 2160
Width = 495
End
Begin VB.CommandButton Command6
Caption = "刷新班级列表"
Height = 1410
Left = 4455
TabIndex = 17
Top = 3615
Width = 330
End
Begin VB.ComboBox Cmbkcm
Height = 300
Left = 2565
TabIndex = 16
Top = -45
Visible = 0 'False
Width = 840
End
Begin VB.TextBox textjsm
Height = 300
Left = 3495
TabIndex = 15
Top = -45
Visible = 0 'False
Width = 915
End
Begin VB.CommandButton Command4
Caption = "清除"
Height = 270
Left = 3540
TabIndex = 10
Top = 2160
Width = 480
End
Begin VB.ListBox List4
Height = 1500
Left = 3540
TabIndex = 9
Top = 675
Width = 945
End
Begin VB.CommandButton Command1
Caption = "任教班级"
Height = 330
Left = 3585
TabIndex = 8
Top = 390
Width = 915
End
Begin VB.ListBox List3
Height = 2580
Left = 3555
MultiSelect = 2 'Extended
TabIndex = 7
Top = 3165
Width = 900
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid HFGd2
Height = 5340
Left = 615
TabIndex = 11
Top = 390
Width = 2940
_ExtentX = 5186
_ExtentY = 9419
_Version = 393216
Rows = 12
Cols = 4
ScrollBars = 2
_NumberOfBands = 1
_Band(0).Cols = 4
End
Begin VB.Image Image3
Height = 480
Left = 105
Picture = "frmin.frx":0000
ToolTipText = "添加新教师"
Top = 2460
Width = 480
End
Begin VB.Image Image7
Height = 480
Left = 180
Picture = "frmin.frx":030A
ToolTipText = "确认监考教师名单"
Top = 360
Visible = 0 'False
Width = 480
End
Begin VB.Image Image6
Height = 480
Left = 120
Picture = "frmin.frx":0614
ToolTipText = "删去当前教师"
Top = 3420
Width = 480
End
Begin VB.Image Image5
Height = 480
Left = 105
Picture = "frmin.frx":091E
ToolTipText = "从Excel粘贴新教师名单"
Top = 1515
Width = 480
End
Begin VB.Image Image2
Height = 480
Left = 3750
Picture = "frmin.frx":0C28
ToolTipText = "将所选课程置为当前班级考试课程"
Top = 2580
Width = 480
End
End
Begin VB.Frame Frame1
BackColor = &H00008000&
Caption = "输入考试班级及其考试课程"
Height = 5940
Left = 30
TabIndex = 0
Top = 285
Width = 4425
Begin VB.CommandButton Command2
Caption = "确认"
Height = 270
Left = 3530
TabIndex = 23
Top = 2430
Width = 540
End
Begin VB.ComboBox Cmbbjh
Height = 300
Left = 2340
TabIndex = 13
Text = "班级号"
Top = -60
Visible = 0 'False
Width = 705
End
Begin VB.ComboBox Cmbnjm
Height = 300
Left = 3060
TabIndex = 12
Text = "年级名"
Top = -45
Visible = 0 'False
Width = 1000
End
Begin VB.ListBox List1
Height = 2040
Left = 2940
MultiSelect = 2 'Extended
TabIndex = 4
Top = 3630
Width = 1110
End
Begin VB.CheckBox Check1
BackColor = &H00008000&
Height = 210
Left = 4125
TabIndex = 3
Top = 3945
Width = 240
End
Begin VB.ListBox List2
Height = 1680
Left = 2955
TabIndex = 2
Top = 750
Width = 1110
End
Begin VB.CommandButton Command3
Caption = "清除"
Height = 270
Left = 2980
TabIndex = 1
Top = 2430
Width = 540
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid HFGd1
Height = 5235
Left = 675
TabIndex = 5
Top = 420
Width = 2250
_ExtentX = 3969
_ExtentY = 9234
_Version = 393216
Rows = 19
Cols = 4
ScrollBars = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 4
End
Begin VB.Label Label3
Caption = "考试课程："
Height = 255
Left = 3000
TabIndex = 21
Top = 480
Width = 1095
End
Begin VB.Label Label1
BackColor = &H00008000&
Caption = "全选"
Height = 420
Left = 4140
TabIndex = 14
Top = 4215
Width = 225
End
Begin VB.Image Image1
Height = 480
Left = 3255
Picture = "frmin.frx":0F32
ToolTipText = "将所选课程置为当前班级考试课程"
Top = 2925
Width = 480
End
Begin VB.Image Image8
Height = 480
Left = 135
Picture = "frmin.frx":123C
ToolTipText = "当前班级上移"
Top = 2295
Width = 480
End
Begin VB.Image Image9
Height = 480
Left = 120
Picture = "frmin.frx":1546
ToolTipText = "当前班级下移"
Top = 3180
Width = 480
End
Begin VB.Image Image10
Height = 480
Left = 120
Picture = "frmin.frx":1850
ToolTipText = "添加新班级"
Top = 1485
Width = 480
End
Begin VB.Image Image11
Height = 480
Left = 105
Picture = "frmin.frx":1B5A
ToolTipText = "删去当前班级"
Top = 4020
Width = 480
End
End
Begin VB.Label Label4
BackColor = &H00008000&
Caption = "(方法是从打开文件窗口选取PK排课软件所在的的安装目录下的 bj.ran 文件)"
Height = 495
Left = 240
TabIndex = 22
Top = 6600
Width = 6975
End
Begin VB.Label Label2
BackColor = &H00008000&
Caption = "如果已经安装PK排课软件，则可以使用后面的按钮直接从排课文件中导入基本数据："
Height = 495
Left = 240
TabIndex = 20
Top = 6360
Width = 6975
End
Begin VB.Menu mnuback
Caption = "返回"
End
End
Attribute VB_Name = "Frmin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Dim jsOk As Boolean
Dim jsmIsNull As Boolean
Private Sub Check1_Click()
Select Case Check1
Case Is = 1
For i = 0 To List1.ListCount - 1
List1.Selected(i) = True
Next i
Case Is = 0
For i = 0 To List1.ListCount - 1
List1.Selected(i) = False
Next i
End Select
End Sub
Private Sub Command2_Click()
With HFGd1
Dim strbj As String
Dim r As Integer
r = .Row
strbj = ""
If r < 1 Or r > .Rows - 2 Then
MsgBox "没有选中当前班级！"
Exit Sub
End If
.Col = 2
strbj = strbj & .Text
.Col = 3
strbj = strbj & .Text
ans = MsgBox("要将表内 " & Str(List2.ListCount) & " 门课设置为 " & strbj & " 班的考试课程吗？", vbYesNo)
If ans = vbNo Then
Exit Sub
End If
If List2.ListCount > Class * Day Then
MsgBox "考试课程数超过设定的节数!"
Exit Sub
End If
.Col = 2
newbjitem.njm = .Text
.Col = 3
newbjitem.bjh = .Text
newbjitem.kskc.num = List2.ListCount
For i = 1 To newbjitem.kskc.num
newbjitem.kskc.list(i) = List2.list(i - 1)
Next
bjarr(r) = newbjitem
End With
End Sub
Private Sub Command3_Click()
List2.Clear
End Sub
Private Sub Command4_Click()
List4.Clear
End Sub
Private Sub Command5_Click()
On Error Resume Next
ans = MsgBox("您已购买并安装了深想系列的PK排课软件吗？", vbYesNo)
If ans = vbNo Then Exit Sub
Dim bjexp As bjtype
Dim kcexp As kctype
Dim kcArr() As kctype
Dim pkPath, pkDir As String
DialogPath.Action = 1
pkPath = Trim(DialogPath.FileName)
Dim endPos As Integer
endPos = 0
If InStr(StrReverse(pkPath), "\") <> 0 Then
endPos = InStr(StrReverse(pkPath), "\")
Else
If InStr(StrReverse(pkPath), "/") <> 0 Then
endPos = InStr(pkPath, "/")
End If
End If
pkDir = Left(pkPath, Len(pkPath) - endPos)
ans = MsgBox("您所选的排课文件路径是 " & pkDir & " , 确定吗？", vbYesNo)
If ans = vbNo Then Exit Sub
ans = MsgBox("下一步将从排课文件中导出班级教师等基本数据到当前监考方案中，如果当前监考方案已有输入数据则被全部覆盖，确定吗？", vbYesNo)
If ans = vbNo Then Exit Sub
Me.MousePointer = 11
Dim bjs As Integer
Open pkDir + "\bjshu.bin" For Binary As #7
Open pkDir + "\bj.ran" For Random As #6 Len = 18
Get #7, 1, bjs
ksbjS = bjs
ReDim bjarr(ksbjS + 1)
With HFGd1
.Rows = ksbjS + 3
For i = 1 To ksbjS '导出班级
Get #6, i, bjexp
bjarr(i).njm = Trim(bjexp.bjnjm)
bjarr(i).bjh = Trim(bjexp.bjbjm)
.Row = i
.Col = 2
.Text = Trim(bjarr(i).njm)
.Col = 3
.Text = Trim(bjarr(i).bjh)
Next i
Close #7
Close #6
End With
'----------------------------------导出课程
Open pkDir + "\kc.ran" For Random As #8 Len = 18
Open pkDir + "\zkcshu.bin" For Binary As #1
Get #1, 1, zkcs: Close #1
Dim minghao() As String * 8
Dim kcmOneArr() As String * 4
ReDim minghao(zkcs)
ReDim kcArr(zkcs)
ReDim kcmOneArr(zkcs)
k = 0 'set js-minghao()
For i = 1 To zkcs 'array ,it's total
Get #8, i, kcArr(i) 'number is jss%=k
For j = 1 To i - 1 'start from No:1
If kcArr(i).kcjsm = minghao(j) Then
GoTo l1
End If
Next j
k = k + 1
minghao(k) = kcArr(i).kcjsm '先形成教师数组
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -