frmdata.frm

来自「能分班系统采用Z线分班方法：即由系统自动抽签(也可由班主任抽签)」· FRM 代码 · 共 205 行

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    =   2220
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4410
   Icon            =   "FrmDATA.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2220
   ScaleWidth      =   4410
   StartUpPosition =   2  'CenterScreen
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4 
      Height          =   585
      Left            =   150
      OleObjectBlob   =   "FrmDATA.frx":2CFA
      TabIndex        =   9
      Top             =   1560
      Width           =   3165
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   630
      Top             =   1770
   End
   Begin VB.TextBox Text3 
      ForeColor       =   &H000000FF&
      Height          =   285
      Left            =   1560
      TabIndex        =   0
      Top             =   960
      Width           =   2475
   End
   Begin VB.Frame Frame1 
      Caption         =   "考试参数"
      Height          =   1365
      Left            =   90
      TabIndex        =   2
      Top             =   120
      Width           =   4185
      Begin VB.TextBox Text1 
         Alignment       =   2  'Center
         ForeColor       =   &H00FF0000&
         Height          =   285
         Left            =   1440
         TabIndex        =   5
         Text            =   "2002"
         Top             =   360
         Width           =   630
      End
      Begin VB.TextBox Text2 
         Alignment       =   2  'Center
         ForeColor       =   &H00FF0000&
         Height          =   285
         Left            =   2940
         TabIndex        =   3
         Text            =   "2003"
         Top             =   360
         Width           =   990
      End
      Begin MSComCtl2.UpDown UpDown1 
         Height          =   285
         Left            =   2071
         TabIndex        =   4
         Top             =   360
         Width           =   240
         _ExtentX        =   423
         _ExtentY        =   503
         _Version        =   393216
         Value           =   1900
         BuddyControl    =   "Text1"
         BuddyDispid     =   196612
         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   =   "FrmDATA.frx":2DAF
         TabIndex        =   6
         Top             =   390
         Width           =   1065
      End
      Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3 
         Height          =   255
         Index           =   1
         Left            =   2520
         OleObjectBlob   =   "FrmDATA.frx":2E0E
         TabIndex        =   7
         Top             =   420
         Width           =   255
      End
      Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3 
         Height          =   255
         Index           =   2
         Left            =   210
         OleObjectBlob   =   "FrmDATA.frx":2E65
         TabIndex        =   8
         Top             =   870
         Width           =   1065
      End
   End
   Begin VB.CommandButton CMNEXT 
      Caption         =   "下一步"
      Height          =   435
      Left            =   3390
      TabIndex        =   1
      Top             =   1650
      Width           =   915
   End
   Begin ACTIVESKINLibCtl.Skin Skin1 
      Left            =   30
      OleObjectBlob   =   "FrmDATA.frx":2EC4
      Top             =   1350
   End
End
Attribute VB_Name = "FrmDATA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim SHFileOp As SHFILEOPSTRUCT
Dim db As Database
Dim STR As String

Private Sub CMNEXT_Click()
    On Error Resume Next

    If Text3.Text = "" Then
        MsgBox "请输入年级名称后再点击下一步", 64, "不完整的设置"
        Exit Sub
    Else

        MousePointer = vbHourglass
        HHVI = Text1.Text & "至" & Text2.Text & "学期" & Text3.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)

        Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
        STR = "INSERT INTO NAME (NAME) VALUES ('" & HHVI & "')"
        db.Execute STR
        db.Close
        Unload Me
        FRMkm.Show
        MousePointer = vbDefault

    End If
End Sub

Private Sub Form_Load()
    On Error Resume Next
    MAIN.Enabled = False
    Skin1.ApplySkin Me.hwnd
End Sub
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

Sub Text3_keyPress(KeyAscii As Integer)

    If KeyAscii = 13 Then
        Call CMNEXT_Click
    End If
End Sub

Private Sub Timer1_Timer()
    On Error Resume Next
    Text2.Text = Val(Text1.Text) + 1
End Sub