formmain.frm

本文首先分析了自动组卷系统在具体的教学活动过程中的实际需求

      Left            =   1440
      TabIndex        =   20
      Top             =   3720
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "请选择题型"
      Height          =   255
      Left            =   0
      TabIndex        =   19
      Top             =   2640
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   " 请选择科目"
      Height          =   375
      Left            =   0
      TabIndex        =   18
      Top             =   3600
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.Menu xtwh 
      Caption         =   "系统维护"
      Begin VB.Menu user 
         Caption         =   "添加用户"
      End
      Begin VB.Menu newdb 
         Caption         =   "新建数据库"
      End
      Begin VB.Menu xiugai 
         Caption         =   "修改密码"
      End
   End
   Begin VB.Menu tkgl 
      Caption         =   "题库管理"
      Begin VB.Menu liulan 
         Caption         =   "浏览"
      End
      Begin VB.Menu delete 
         Caption         =   "删除"
      End
      Begin VB.Menu modify 
         Caption         =   "修改"
      End
      Begin VB.Menu update 
         Caption         =   "更新"
      End
      Begin VB.Menu add 
         Caption         =   "添加"
      End
      Begin VB.Menu exitt 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu zdzj 
      Caption         =   "自动组卷"
   End
   Begin VB.Menu helpwj 
      Caption         =   "帮助文件"
      Begin VB.Menu about 
         Caption         =   "关于"
      End
      Begin VB.Menu help 
         Caption         =   "help"
      End
   End
   Begin VB.Menu exit 
      Caption         =   "退出"
   End
End
Attribute VB_Name = "Formmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim e As Boolean
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private bordercolor1 As OLE_COLOR
Private bordercolor2 As OLE_COLOR

Private Sub Command1_Click()
Dim objWord As Object
Const CLASSOBJECT = "Word.Application"

Set objWord = CreateObject(CLASSOBJECT)
objWord.Visible = True
objWord.Documents.Open (App.Path & "\套卷1")
End Sub

Private Sub about_Click()
formabout.Visible = True
End Sub

Private Sub add_Click()
For i = 0 To 4
DataGrid1(i).Visible = False
Text1(i).Visible = False
Text2(i).Visible = True
Text2(i).Text = " "
Next i
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
Label7.Visible = True
Combo1.Visible = True
Combo2.Visible = True
End Sub

Private Sub help_Click()
helpf.Visible = True
End Sub

Private Sub modify_Click()
i = Combo2.ListIndex
Adodc1(i).Recordset.update
End Sub


Private Sub user_Click()
Load adduser
adduser.Visible = True

End Sub

Private Sub Combo1_Click()
Select Case Combo1.Text
 Case "英语"
  Combo2.Clear
  Combo2.AddItem "选择题"
  Combo2.AddItem "完型填空"
  Combo2.AddItem "书面表达"
  Combo2.AddItem "短文改错"
  Combo2.AddItem "阅读理解"
  Combo2.Text = "题型"
  Case "工程力学"
  Combo2.Clear
  Combo2.AddItem "选择题"
  Combo2.AddItem "填空"
  Combo2.AddItem "判断"
  Combo2.AddItem "解答题"
  Combo2.Text = "题型"
  End Select
End Sub

Private Sub Combo2_Click()
 i = Combo2.ListIndex
  Text1(i).ZOrder
  DataGrid1(i).ZOrder
  Adodc1(i).ZOrder
  Adodc1(i).Visible = True
End Sub

Private Sub daoru_Click()

CommonDialog1.Flags = 0
CommonDialog1.ShowOpen
edir = CommonDialog1.FileName

Dim excel_app As Object
Dim excel_sheet As Object
Dim db As Database
Dim new_value As String
Dim row As Integer

    Screen.MousePointer = vbHourglass
    DoEvents
    Set excel_app = CreateObject("Excel.Application")
    excel_app.Workbooks.Open FileName = "c:\windows\desktop\book1.xls"

    If Val(excel_app.Application.Version) >= 8 Then
        Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If
    Set db = OpenDatabase(adir)



    row = 1
    Do
        
        new_value = Trim$(excel_sheet.Cells(row, 1))

        If Len(new_value) = 0 Then Exit Do
      db.Execute "INSERT INTO TestValues VALUES (" & _
            new_value & ")"

        row = row + 1
    Loop


    db.Close
    Set db = Nothing

  

    excel_app.ActiveWorkbook.Close False


    excel_app.Quit
    Set excel_sheet = Nothing
    Set excel_app = Nothing

    Screen.MousePointer = vbDefault

End Sub

Private Sub delete_Click()
Dim r As Integer
r = MsgBox("确定删除当前记录？", vbExclamation + vbYesNo)
If r = vbYes Then
i = Combo2.ListIndex
Adodc1(i).Recordset.delete
Adodc1(i).Recordset.MoveNext
If Adodc1(i).Recordset.EOF Then
Adodc1(i).Recordset.MoveLast
End If
End If
End Sub

Private Sub exit_Click()
End
End Sub

Private Sub exitt_Click()
Combo1.Visible = False
Combo2.Visible = False
For i = 0 To 4
Adodc1(i).Visible = False
DataGrid1(i).Visible = False
Text1(i).Visible = False
Text2(i).Visible = False

Next
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
Label7.Visible = False
End Sub

Private Sub Form_Load()
bordercolor1 = &HB08000
bordercolor2 = &HFFFFFF
Toolbar1.MouseIcon = LoadPicture(App.Path & "\hand.cur")
    UCtitlebar1.Btnsize = 15
    UCtitlebar1.Height = 330
    UCtitlebar1.BackColor = &H8080FF
    Set UCtitlebar1.ImageCloseN = LoadPicture(App.Path & "\skin\close.bmp")
    Set UCtitlebar1.ImageMinN = LoadPicture(App.Path & "\skin\min.bmp")
    Set UCtitlebar1.ImageMaxN = LoadPicture(App.Path & "\skin\max.bmp")
    Set UCtitlebar1.ImageRestoreN = LoadPicture(App.Path & "\skin\restore.bmp")
    Set UCtitlebar1.ImageCloseD = LoadPicture(App.Path & "\skin\closedown.bmp")
    Set UCtitlebar1.ImageMinD = LoadPicture(App.Path & "\skin\mindown.bmp")
    Set UCtitlebar1.ImageMaxD = LoadPicture(App.Path & "\skin\maxdown.bmp")
    Set UCtitlebar1.ImageRestoreD = LoadPicture(App.Path & "\skin\restoredown.bmp")
    Set UCtitlebar1.BGpic = LoadPicture(App.Path & "\skin\Caption.bmp")
   UCtitlebar1.Convert Me
    
    UCtitlebar1.Top = 0
    UCtitlebar1.Left = 0
    
  For i = 0 To 4
Adodc1(i).ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\datadb.mdb;"
Next
Adodc1(0).RecordSource = "选择题"
Adodc1(1).RecordSource = "完型填空"
Adodc1(2).RecordSource = "书面表达"
Adodc1(3).RecordSource = "短文改错"
Adodc1(4).RecordSource = "阅读理解"
 For j = 0 To 4
Set Text1(j).DataSource = Adodc1(j)
 Text1(j).DataField = "题目"
Set DataGrid1(j).DataSource = Adodc1(j)
Next
Combo1.Clear
Combo1.AddItem "英语"
Combo1.AddItem "数学"
Combo1.Text = "科目"
  

End Sub


Private Sub Form_Paint()
    UCtitlebar1.DrawFrmBorder Me, bordercolor1, bordercolor2
    UCtitlebar1.DrawBG Me, App.Path & "\skin\Bkground.BMP"
End Sub



Private Sub Form_Resize()
    If Me.BorderStyle = 2 Then
        UCtitlebar1.Width = Me.ScaleWidth
        UCtitlebar1.DrawFrmBorder Me, bordercolor1, bordercolor2
    End If
End Sub
Private Sub Image2_Click()
Load Form1
Form1.Show
End Sub

Private Sub ku_Click()
CommonDialog1.Flags = 0
CommonDialog1.ShowOpen
shujuku = CommonDialog1.FileName
Set MSAccess = New Access.Application
    MSAccess.Visible = True
    MSAccess.OpenCurrentDatabase (shukuju)
End Sub


Private Sub Label3_Click()
 End
End Sub

Private Sub liulan_Click()
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
Label4.Visible = False
Label5Visible = False
Label6Visible = False
Label7.Visible = False

For i = 0 To 4
DataGrid1(i).Visible = True
Text1(i).Visible = True
Combo1.Visible = True
Combo2.Visible = True
Text2(i).Visible = False
Next i
Label3.Visible = True
End Sub

Private Sub open_Click()
'CommonDialog1.Flags = 0
'CommonDialog1.ShowOpen
'shujuku = CommonDialog1.FileName
 'Set MSAccess = New Access.Application
    '   MSAccess.Visible = True
    '  MSAccess.OpenCurrentDatabase (App.Path & "\ee.mdb")

End Sub


Private Sub newdb_Click()
CommonDialog1.Flags = 0
CommonDialog1.ShowSave
newd = CommonDialog1.FileName
Set MSAccess = New Access.Application
  MSAccess.Visible = True
   
    MSAccess.NewCurrentDatabase (newd)
     
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)

Select Case Button.Index
Case 1
   newdb_Click
Case 2

Case 3
liulan_Click
Case 4
Clipboard.Clear
Clipboard.SetText Adodc1(i).Recordset("题目")
Adodc1(1).Recordset("题目") = ""
Case 5
Clipboard.Clear
Clipboard.SetText Adodc1(i).Recordset("题目")
Case 6
delete_Click
Case 7
Adodc1(i).Recordset("题目") = Clipboard.GetText
Case 8
Adodc1(i).Recordset.Cancel
Case 9
CommonDialog1.Flags = 256
CommonDialog1.ShowPrinter
End Select
End Sub

Private Sub UCtitlebar1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
UCtitlebar1.DrawFrmBorder Me, bordercolor1, bordercolor2
End Sub



Private Sub Form_Unload(Cancel As Integer)

    UCtitlebar1.FreeMaxMin
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Label3.ForeColor <> vbBlue Then
Label3.ForeColor = vbBlue
End If
End Sub

Private Sub update_Click()
i = Combo2.ListIndex
Adodc1(i).Recordset.AddNew
Adodc1(i).Recordset("题号") = CInt(Text2(0).Text)
If i = 0 Or i = 4 Then
Adodc1(i).Recordset("知识点") = (Text2(3).Text)
End If
Adodc1(i).Recordset("分值") = CInt(Text2(1).Text)
Adodc1(i).Recordset("难度") = Text2(2).Text
Adodc1(i).Recordset("题目") = Text2(4).Text
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
Label4.Visible = False
Label5Visible = False
Label6Visible = False
Label7.Visible = False

For i = 0 To 4
DataGrid1(i).Visible = True
Text1(i).Visible = True
Combo1.Visible = True
Combo2.Visible = True
Text2(i).Visible = False
Next i
Label3.Visible = True

End Sub

Private Sub xiugai_Click()
Load xgmm
xgmm.Visible = True
End Sub

Private Sub xtwh_Click()
If Not e Then
chshi:
 qx = InputBox("请输入管理员密码", "权限验证")
 If qx <> "1234" Then

m = MsgBox("您输入的密码不正确,请重新输入", vbRetryCancel)
  If m = 4 Then
 GoTo chshi
End If
Else
e = True
End If
End If
End Sub

Private Sub zdzj_Click()
组卷.Visible = True
End Sub