📄 frmksbg.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 FrmKSBG
BorderStyle = 3 'Fixed Dialog
Caption = "考试类型变更"
ClientHeight = 3120
ClientLeft = 45
ClientTop = 435
ClientWidth = 4380
Icon = "FrmKSBG.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3120
ScaleWidth = 4380
StartUpPosition = 2 '屏幕中心
Begin ACTIVESKINLibCtl.Skin Skin1
Left = 1110
OleObjectBlob = "FrmKSBG.frx":1042
Top = 2670
End
Begin VB.Timer Timer1
Interval = 10
Left = 420
Top = 2700
End
Begin VB.CommandButton Command2
Caption = "退出更改"
Height = 525
Left = 1800
TabIndex = 13
Top = 2520
Width = 1155
End
Begin VB.CommandButton Command1
Caption = "确定更改"
Height = 525
Left = 3120
TabIndex = 12
Top = 2520
Width = 1155
End
Begin VB.Frame Frame1
Caption = "考试参数变更"
Height = 2295
Left = 105
TabIndex = 0
Top = 120
Width = 4185
Begin VB.TextBox Text1
Alignment = 2 'Center
ForeColor = &H00FF0000&
Height = 285
Left = 1440
TabIndex = 6
Text = "2002"
Top = 360
Width = 615
End
Begin VB.TextBox Text2
Alignment = 2 'Center
ForeColor = &H00FF0000&
Height = 285
Left = 2910
TabIndex = 4
Text = "2003"
Top = 360
Width = 990
End
Begin VB.ComboBox Combo3
ForeColor = &H00FF0000&
Height = 300
ItemData = "FrmKSBG.frx":4B531
Left = 1440
List = "FrmKSBG.frx":4B53B
Style = 2 'Dropdown List
TabIndex = 3
Top = 810
Width = 1665
End
Begin VB.ComboBox Combo4
ForeColor = &H00FF0000&
Height = 300
ItemData = "FrmKSBG.frx":4B54F
Left = 1440
List = "FrmKSBG.frx":4B551
Style = 2 'Dropdown List
TabIndex = 1
Top = 1770
Width = 1695
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 315
Left = 1440
TabIndex = 2
Top = 1290
Width = 1665
_ExtentX = 2937
_ExtentY = 556
_Version = 393216
CalendarTitleBackColor= 16638646
Format = 24641536
CurrentDate = 37788
End
Begin MSComCtl2.UpDown UpDown1
Height = 285
Left = 2056
TabIndex = 5
Top = 360
Width = 255
_ExtentX = 450
_ExtentY = 503
_Version = 393216
Value = 1900
BuddyControl = "Text1"
BuddyDispid = 196613
OrigLeft = 2310
OrigTop = 360
OrigRight = 2565
OrigBottom = 645
Max = 9999
Min = 1000
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 0
Left = 210
OleObjectBlob = "FrmKSBG.frx":4B553
TabIndex = 7
Top = 390
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 1
Left = 2520
OleObjectBlob = "FrmKSBG.frx":4B5B2
TabIndex = 8
Top = 390
Width = 255
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 2
Left = 210
OleObjectBlob = "FrmKSBG.frx":4B609
TabIndex = 9
Top = 870
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 3
Left = 210
OleObjectBlob = "FrmKSBG.frx":4B668
TabIndex = 10
Top = 1350
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 4
Left = 210
OleObjectBlob = "FrmKSBG.frx":4B6C7
TabIndex = 11
Top = 1800
Width = 1065
End
End
End
Attribute VB_Name = "FrmKSBG"
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 One As String
Dim oneNJ As String
Dim SHFileOp As SHFILEOPSTRUCT
Dim HHVI As String
Dim HHVIHA As String
Private Sub Command1_Click()
On Error Resume Next
Select Case MsgBox("是否真的变更此数据库吗？", vbOKCancel, "警告！")
Case vbOK
HHVI = Text1.Text & "至" & Text2.Text & Combo3.Text & oneNJ & Combo4.Text & DTPicker1.Value
HHVIHA = Text1.Text & "至" & Text2.Text & Combo3.Text & oneNJ & Combo4.Text
If HHVIHA = One Then MsgBox "更改后的类型与原数据相同", 64, "无需变更": Exit Sub
Set db = OpenDatabase(MAIN.CMD2.filename)
db.Execute "UPDATE COM SET 代码='" & HHVIHA & "' WHERE 标记='名称'"
db.Close
Set db = Nothing
SHFileOp.wFunc = FO_COPY
SHFileOp.pFrom = MAIN.CMD2.filename
SHFileOp.pTo = App.Path & "\DATA\" & HHVI & ".NHB"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
MsgBox "数据成功变更!", 32, "提示"
Select Case MsgBox("是否删除原数据吗？", vbOKCancel, "警告！")
Case vbOK
SHFileOp.wFunc = FO_DELETE
SHFileOp.pFrom = MAIN.CMD2.filename
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
MsgBox "成功删除原数据!", 32, "提示"
MAIN.CMD2.filename = ""
Unload Me
Case Else
Cancel = True
Unload Me
End Select
Case Else
Cancel = True
Unload Me
End Select
End Sub
Private Sub Command2_Click()
On Error Resume Next
Unload Me
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
Private Sub Timer1_Timer()
On Error Resume Next
Text2.Text = Val(Text1.Text) + 1
End Sub
Private Sub Form_Load()
On Error Resume Next
MAIN.Enabled = False
' Skin1.LoadSkin App.Path & "\SKIN\8.sk"
Skin1.ApplySkin Me.hwnd
Combo3.ListIndex = 0
prevWndProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC)
SetWindowLong Text1.hwnd, GWL_WNDPROC, AddressOf WndProc
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
Combo4.AddItem rs![考试名称]
rs.MoveNext
Next intCounter
Combo4.ListIndex = 0
If MAIN.CMD2.filename = "" Then MsgBox "未载入更改数据对象", 32, "提示": Command1.Enabled = False: Exit Sub
Set db = OpenDatabase(MAIN.CMD2.filename)
Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='名称'")
One = rs![代码]
Set db = OpenDatabase(MAIN.CMD2.filename)
Set rs = db.OpenRecordset("SELECT * FROM 年级")
oneNJ = rs![年级]
db.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -