?? 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 + -