frmfsbg.frm

1.如果在向导设置班级数为8时,此数值为班级总数

VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "ACTSKIN4.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FRMFSBG 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "分数变更"
   ClientHeight    =   2115
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   3390
   Icon            =   "FRMFSBG.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2115
   ScaleWidth      =   3390
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog CMD1 
      Left            =   3210
      Top             =   2100
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.ComboBox Combo2 
      ForeColor       =   &H00FF0000&
      Height          =   300
      Left            =   1110
      Style           =   2  'Dropdown List
      TabIndex        =   8
      Top             =   300
      Width           =   885
   End
   Begin VB.TextBox Text1 
      ForeColor       =   &H00FF00FF&
      Height          =   255
      Left            =   1110
      TabIndex        =   7
      Top             =   1590
      Width           =   885
   End
   Begin VB.ComboBox Combo1 
      ForeColor       =   &H000000FF&
      Height          =   300
      ItemData        =   "FRMFSBG.frx":0E42
      Left            =   1110
      List            =   "FRMFSBG.frx":0E4C
      Style           =   2  'Dropdown List
      TabIndex        =   6
      Top             =   930
      Width           =   885
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出变更"
      Height          =   495
      Left            =   2190
      TabIndex        =   2
      Top             =   1470
      Width           =   1065
   End
   Begin VB.CommandButton Command2 
      Caption         =   "确定变更"
      Enabled         =   0   'False
      Height          =   495
      Left            =   2190
      TabIndex        =   1
      Top             =   870
      Width           =   1065
   End
   Begin VB.CommandButton Command1 
      Caption         =   "载入数据库"
      Height          =   495
      Left            =   2190
      TabIndex        =   0
      Top             =   240
      Width           =   1065
   End
   Begin ACTIVESKINLibCtl.Skin Skin1 
      Left            =   180
      OleObjectBlob   =   "FRMFSBG.frx":0E56
      Top             =   1170
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4 
      Height          =   225
      Index           =   0
      Left            =   150
      OleObjectBlob   =   "FRMFSBG.frx":4B345
      TabIndex        =   3
      Top             =   330
      Width           =   825
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4 
      Height          =   225
      Index           =   1
      Left            =   150
      OleObjectBlob   =   "FRMFSBG.frx":4B3A2
      TabIndex        =   4
      Top             =   960
      Width           =   855
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4 
      Height          =   285
      Index           =   2
      Left            =   150
      OleObjectBlob   =   "FRMFSBG.frx":4B3FF
      TabIndex        =   5
      Top             =   1590
      Width           =   825
   End
End
Attribute VB_Name = "FRMFSBG"
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
Private Sub Command1_Click()
    On Error GoTo 32755
    Cmd1.Flags = cdlOFNHideReadOnly
    Cmd1.Filter = "NHB数据文件(*.NHB)|*.NHB|"
    Cmd1.InitDir = App.Path
    Cmd1.FilterIndex = 2
    Cmd1.ShowOpen
    If Cmd1.filename <> "" Then
        Command2.Enabled = True
        Combo2.Clear
        Set db = OpenDatabase(Cmd1.filename)
        Set rs = db.OpenRecordset("科目")
        rs.MoveLast
        intRecCount = rs.RecordCount
        rs.MoveFirst
        For intCounter = 1 To intRecCount
            Combo2.AddItem rs![科目]
            rs.MoveNext
        Next intCounter
        Combo2.ListIndex = 0
    Else
        Exit Sub
        Unload Me
    End If
32755:
    Select Case Err.Number
        Case 3343
            MsgBox "此数据格式不对,请使用正确的NHB数据库进行导入", 32, "无法导入"
            Unload Me
        Case 3061
            MsgBox "此数据被破坏,请使用数据恢复来修复此数据库", 32, "无法导入"
            Unload Me
        Case 3078
            MsgBox "此数据格式不对或被破坏", 32, "无法导入"
            Unload Me
    End Select
End Sub
Private Sub Command2_Click()
    On Error Resume Next
    Set db = DBEngine.Workspaces(0).OpenDatabase(Cmd1.filename)
    db.Execute "UPDATE 学生 SET " & Combo2.Text & "=" & Combo2.Text & "  " & Combo1.Text & " " & Text1.Text & ""
    db.Close
    MsgBox "数据变更成功"
    Unload Me
End Sub
Private Sub Command3_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    On Error Resume Next
    MAIN.Enabled = False
    '    Skin1.LoadSkin App.Path & "\SKIN\4.sk"
    Skin1.ApplySkin Me.hwnd
    Combo1.ListIndex = 0
    prevWndProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC)
    SetWindowLong Text1.hwnd, GWL_WNDPROC, AddressOf WndProc
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 Text1_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    Select Case KeyAscii
        Case 48 To 57, 8
        Case 46
            If InStr(Text1.Text, ".") <> 0 Then
                KeyAscii = 0
            End If
        Case Else
            KeyAscii = 0
    End Select
End Sub