📄 frmdata.frm
字号:
VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "actskin4.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FrmDATA
BorderStyle = 3 'Fixed Dialog
Caption = "设置考试参数"
ClientHeight = 3495
ClientLeft = 45
ClientTop = 330
ClientWidth = 4740
Icon = "FrmDATA.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3495
ScaleWidth = 4740
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton CMNEXT
Caption = "下一步"
Height = 435
Left = 3600
TabIndex = 18
Top = 2970
Width = 1035
End
Begin VB.Timer Timer1
Interval = 1
Left = 4140
Top = 6360
End
Begin VB.ComboBox Combo2
ForeColor = &H000000FF&
Height = 300
ItemData = "FrmDATA.frx":030A
Left = 3900
List = "FrmDATA.frx":0386
Style = 2 'Dropdown List
TabIndex = 4
Top = 150
Width = 675
End
Begin VB.CommandButton Command1
Caption = "年级设置"
Height = 315
Left = 2100
TabIndex = 3
Top = 150
Width = 915
End
Begin VB.ComboBox Combo1
ForeColor = &H000000FF&
Height = 300
Left = 900
Style = 2 'Dropdown List
TabIndex = 2
Top = 150
Width = 1125
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1
Height = 255
Left = 180
OleObjectBlob = "FrmDATA.frx":0421
TabIndex = 1
Top = 150
Width = 735
End
Begin VB.Frame Frame1
Caption = "考试参数"
Height = 2295
Left = 135
TabIndex = 0
Top = 600
Width = 4485
Begin VB.CommandButton Command2
Caption = "类型设置"
Height = 315
Left = 3300
TabIndex = 17
Top = 1770
Width = 915
End
Begin VB.ComboBox Combo4
ForeColor = &H00FF0000&
Height = 300
ItemData = "FrmDATA.frx":047C
Left = 1440
List = "FrmDATA.frx":047E
Style = 2 'Dropdown List
TabIndex = 16
Top = 1770
Width = 1695
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 315
Left = 1440
TabIndex = 15
Top = 1290
Width = 1665
_ExtentX = 2937
_ExtentY = 556
_Version = 393216
CalendarTitleBackColor= 16638646
Format = 61997056
CurrentDate = 37788
End
Begin VB.ComboBox Combo3
ForeColor = &H00FF0000&
Height = 300
ItemData = "FrmDATA.frx":0480
Left = 1440
List = "FrmDATA.frx":048A
Style = 2 'Dropdown List
TabIndex = 12
Top = 810
Width = 1665
End
Begin VB.TextBox Text2
Alignment = 2 'Center
ForeColor = &H00FF0000&
Height = 285
Left = 3210
TabIndex = 10
Text = "2003"
Top = 360
Width = 990
End
Begin MSComCtl2.UpDown UpDown1
Height = 285
Left = 2310
TabIndex = 8
Top = 360
Width = 255
_ExtentX = 450
_ExtentY = 503
_Version = 393216
Value = 1900
AutoBuddy = -1 'True
BuddyControl = "Text1"
BuddyDispid = 196619
OrigLeft = 2190
OrigTop = 360
OrigRight = 2445
OrigBottom = 675
Max = 9999
Min = 1000
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.TextBox Text1
Alignment = 2 'Center
ForeColor = &H00FF0000&
Height = 285
Left = 1440
TabIndex = 7
Text = "2002"
Top = 360
Width = 870
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 0
Left = 210
OleObjectBlob = "FrmDATA.frx":049E
TabIndex = 6
Top = 390
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 1
Left = 2760
OleObjectBlob = "FrmDATA.frx":04FD
TabIndex = 9
Top = 390
Width = 255
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 2
Left = 210
OleObjectBlob = "FrmDATA.frx":0554
TabIndex = 11
Top = 870
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 3
Left = 210
OleObjectBlob = "FrmDATA.frx":05B3
TabIndex = 13
Top = 1350
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 4
Left = 210
OleObjectBlob = "FrmDATA.frx":0612
TabIndex = 14
Top = 1800
Width = 1065
End
End
Begin ACTIVESKINLibCtl.Skin Skin1
Left = 1890
OleObjectBlob = "FrmDATA.frx":0671
Top = 3000
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel2
Height = 255
Left = 3120
OleObjectBlob = "FrmDATA.frx":4AB60
TabIndex = 5
Top = 180
Width = 735
End
End
Attribute VB_Name = "FrmDATA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset
Dim STR As String
Dim NUM As Long
Dim SHFileOp As SHFILEOPSTRUCT
Dim HHVI As String '名称保存
Dim HHVIHA As String '共打印的标题
Dim gyxes As Integer '共班级数目变量
Private Sub CMNEXT_Click()
On Error Resume Next
MousePointer = vbHourglass
HHVI = Text1.Text & "至" & Text2.Text & Combo3.Text & Combo1.Text & Combo4.Text & DTPicker1.Value
HHVIHA = Text1.Text & "至" & Text2.Text & Combo3.Text & Combo1.Text & Combo4.Text
SHFileOp.wFunc = FO_COPY
SHFileOp.pFrom = App.Path & "\DATA.PAS"
SHFileOp.pTo = App.Path & "\TEMP\" & HHVI & ".NHB"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
'以下代码将选择的设置进行名称保存,并且COPY于APP.PATH\TEMP下,暂存
Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
STR = "INSERT INTO COM (标记,代码) VALUES ('完整名称','" & HHVI & "')"
db.Execute STR
db.Close
Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
STR = "INSERT INTO COM (标记,代码) VALUES ('名称','" & HHVIHA & "')"
db.Execute STR
db.Close
Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
STR = "INSERT INTO 年级 (年级,学年1,学年2,学期,考试日期,考试名称,班级数) VALUES ('" & Combo1 & "','" & Text1 & "','" & Text2 & "','" & Combo3 & "','" & DTPicker1 & "','" & Combo4 & "','" & Combo2 & "')"
db.Execute STR
db.Close
For gyxes = 1 To Combo2
Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
STR = "INSERT INTO 班级 (班级) VALUES ('" & gyxes & "')"
db.Execute STR
db.Close
Next
DD = HHVI
FRMkm.Show
MousePointer = vbDefault
Unload Me
End Sub
Private Sub Command1_Click()
On Error Resume Next
Me.Enabled = False
FRMnjsz1.Show
End Sub
Private Sub Command2_Click()
On Error Resume Next
Me.Enabled = False
FRMksmc1.Show
End Sub
Private Sub Form_Activate()
On Error Resume Next
Combo1.Clear
Combo4.Clear
Set db = OpenDatabase(App.Path & "\SET.PAS")
Set rs = db.OpenRecordset("年级")
rs.MoveLast
intRecCount = rs.RecordCount
rs.MoveFirst
For intCounter = 1 To intRecCount
Combo1.AddItem rs![年级]
rs.MoveNext
Next intCounter
Combo1.ListIndex = 0
Set db = OpenDatabase(App.Path & "\SET.PAS")
Set rs = db.OpenRecordset("考试名称")
rs.MoveLast
intRecCount = rs.RecordCount
rs.MoveFirst
For intCounter = 1 To intRecCount
Combo4.AddItem rs![考试名称]
rs.MoveNext
Next intCounter
Combo4.ListIndex = 0
End Sub
Private Sub Form_Load()
On Error Resume Next
MAIN.Enabled = False
' Skin1.LoadSkin App.Path & "\SKIN\8.sk"
Skin1.ApplySkin Me.hwnd
Combo2.ListIndex = 0
Combo3.ListIndex = 0
prevWndProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC)
SetWindowLong Text1.hwnd, GWL_WNDPROC, AddressOf WndProc
'
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Text2.Text = Val(Text1.Text) + 1
End Sub
'下面的代码可以关闭所有打开的 DAO workspace，并释放所占的内存。
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
MAIN.Enabled = True
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
For Each ws In Workspaces
For Each db In ws.Databases
For Each rs In db.Recordsets
rs.Close
Set rs = Nothing
Next
db.Close
Set db = Nothing
Next
ws.Close
Set ws = Nothing
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -