frmtiankong.frm

vb试卷生成系统！能够生成8开vb考试试卷

Adodc2.Refresh
If Adodc2.Recordset.RecordCount = 0 And adodc1.Recordset.RecordCount > 0 Then
    Adodc3.Recordset.AddNew
    Adodc3.Recordset.Fields(0) = Text1.Text
    Adodc3.Recordset.Fields(1) = Text2.Text
    If Combo1.ListIndex > 1 Then
        Adodc3.Recordset.Fields(2) = Text7.Text
    End If
    MsgBox "成功加入考题试卷中。", vbInformation, App.EXEName
    Adodc3.Recordset.Update
Else
    MsgBox "试卷中己有此题,或试图加入空记录！加入失败。", vbInformation, App.EXEName
End If
End Sub

Private Sub Command16_Click()
End Sub

Private Sub Command2_Click()
Command1_Click
Command1_Click
End Sub

Private Sub Command3_Click()
Command2_Click
Command2_Click
End Sub

Public Sub Command4_Click()
If Text3.Text = "" Or Text4.Text = "" Then
    MsgBox "题目或答案还有的未填写完整，请继续填写。", vbInformation, "无法更新"
    Text3.SetFocus
Else
linkku = "tiankongti" + Trim(Str(Combo1.ListIndex + 1))
If Combo1.ListIndex < 2 Then
    Adodc4.RecordSource = "select * from " + linkku + " where neirong='" + Text3.Text + "'"
Else
    Adodc4.RecordSource = "select * from " + linkku + " where neirong+addneirong='" + Text3.Text + "'"
End If
Adodc4.Refresh
If Adodc4.Recordset.RecordCount <> 0 And presskey = "添加" Then
    MsgBox "该记录已经存在于数据库中，无法新添加", vbExclamation, App.EXEName
    Command5_Click
    Exit Sub
End If
Command6.Default = True
If presskey = "添加" Then
    recordc = recordc + 1
    recordnum = recordc
    adodc1.Recordset.AddNew
End If
Dim lsneirong As String
Dim textnum, k, g As Integer
lsneirong = Text3.Text
textnum = 0
Text1.Text = ""
Text7.Text = ""
For k = 1 To Len(lsneirong)
    If Asc(Mid(lsneirong, k, 1)) < 0 Then
        textnum = textnum + 2
    Else
        textnum = textnum + 1
    End If
    If textnum >= 250 And k < Len(lsneirong) Then
        If Combo1.ListIndex <= 1 Then
            MsgBox "你输入的内容太长，无法完全存放入数据库中。" + Chr(13) + "多余的部分将被截去。", vbInformation, App.EXEName
        End If
        Exit For
    End If
Next k
If k >= Len(lsneirong) Then
    Text1.Text = lsneirong
Else
    Text1.Text = Mid(lsneirong, 1, k)
    If Combo1.ListIndex > 1 Then
        lsneirong = Mid(lsneirong, k + 1, Len(lsneirong) - k)
        textnum = 0
        For g = 1 To Len(lsneirong)
            If Asc(Mid(lsneirong, g, 1)) < 0 Then
                textnum = textnum + 2
            Else
                textnum = textnum + 1
            End If
            If textnum >= 250 And g < Len(lsneirong) Then
                MsgBox "你输入的内容太长，无法完全存放入数据库中。" + Chr(13) + "多余的部分将被截去。", vbInformation, App.EXEName
                Exit For
            End If
        Next g
        If g >= Len(lsneirong) Then
            Text7.Text = lsneirong
        Else
            Text7.Text = Mid(lsneirong, 1, g)
        End If
    Else
        Text7.Text = ""
    End If
End If


Text2.Text = Text4.Text
Text1.SetFocus
Text2.SetFocus
adodc1.Recordset.MovePrevious
adodc1.Recordset.MoveNext
huifu
End If
stats = "当前记录：" + Str(recordnum) + "/" + Str(recordc) + "    浏览状态"
fMainForm.sbStatusBar.Panels(1).Text = stats
End Sub

Private Sub Command5_Click()
Command6.Default = True
Text3.Text = Text1.Text
Text4.Text = Text2.Text
huifu
stats = "当前记录：" + Str(recordnum) + "/" + Str(recordc) + "    浏览状态"
fMainForm.sbStatusBar.Panels(1).Text = stats
End Sub

Public Sub Command6_Click()
Command6.Default = False
Text3.Text = ""
Text4.Text = ""
huifu
presskey = "添加"
Text3.SetFocus
stats = "当前记录：EOF/EOF    (插入状态)"
fMainForm.sbStatusBar.Panels(1).Text = stats
End Sub

Public Sub Command7_Click()
If adodc1.Recordset.RecordCount <> 0 Then
    Command6.Default = False
    presskey = "修改"
    huifu
    stats = "当前记录：" + Str(recordnum) + "/" + Str(recordc) + "    修改状态"
    fMainForm.sbStatusBar.Panels(1).Text = stats
    Text3.SetFocus
End If
End Sub

Public Sub Command8_Click()
If recordc >= 1 Then
presskey = "删除"
tuichu = MsgBox("确定此题吗？", vbYesNo + vbQuestion, "确认？")
If tuichu = 6 Then
    adodc1.Recordset.Delete
    recordc = recordc - 1
    If recordc < recordnum Then
        recordnum = recordc
    End If
End If
If recordnum = 0 Then
    stats = "当前记录：BOF/EOF"
Else
    stats = "当前记录：" + Str(recordnum) + "/" + Str(recordc) + "    浏览状态"
End If
fMainForm.sbStatusBar.Panels(1).Text = stats
End If
End Sub

Private Sub Command9_Click()
If recordnum = 1 Then
    MsgBox "己到记录首", vbInformation, "查询"
Else
For i = recordnum - 1 To 1 Step -1
    Command12_Click
    lookfor
    If find1 And find2 Then
        Exit Sub
    End If
    If i = 1 Then
        MsgBox "没有找到符合条件的记录！", vbInformation, "无此记录"
    End If
Next i
End If
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If LastRow <> "" And Text1.Text <> "" Then
    recordnum = DataGrid1.GetBookmark(0)
    If recordnum > recordc Then
        recordnum = recordc
    End If
    stats = "当前记录：" + Str(recordnum) + "/" + Str(recordc) + "    浏览状态"
    fMainForm.sbStatusBar.Panels(1).Text = stats
End If
End Sub

Private Sub Form_Activate()
'Me.WindowState = 2
Me.top = 0
Me.left = 0
Me.Height = 7000
Me.Width = 11720
recordc = adodc1.Recordset.RecordCount
If recordc >= 1 Then
    recordnum = 1
    adodc1.Recordset.Move (0)
Else
    recordnum = 0
End If
stats = "当前记录：" + Str(recordnum) + "/" + Str(recordc) + "    浏览状态"
fMainForm.sbStatusBar.Panels(1).Text = stats
End Sub

Private Sub Form_Deactivate()
If Command5.Enabled Then
    Command5_Click
End If
Unload Me
End Sub

Private Sub Form_Load()
adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\kaoti.mdb;Persist Security Info=False"
adodc1.RecordSource = "tiankongti1"
adodc1.Refresh
Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\SHIJUAN.mdb;Persist Security Info=True"
Adodc3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\SHIJUAN.MDB;Persist Security Info=False"
Adodc3.RecordSource = "yxuanze1"
Adodc3.Refresh
Adodc4.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\kaoti.mdb;Persist Security Info=False"

Combo1.ListIndex = 0
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Command5.Enabled Then
    Command5_Click
End If
End Sub

Private Sub Frame3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 And Command6.Enabled = True Then
    If recordc = 0 Then
        frmmnu.gotond1.Enabled = False
        frmmnu.gotond2.Enabled = False
    Else
        If Combo1.Text = "" Or Combo1.Text = "1" Or Combo1.Text = "3" Then
            frmmnu.gotond1.Enabled = False
            frmmnu.gotond2.Enabled = True
        Else
            frmmnu.gotond1.Enabled = True
            frmmnu.gotond2.Enabled = False
        End If
    End If
    PopupMenu frmmnu.popmnu
End If
End Sub

Private Sub Frame3_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label1.ForeColor = &H0&
End Sub

Public Sub Label1_Click()
If recordc <> 0 Then
    Dim dfile, inputTip, inputs, ls As String
    Dim InFile As Integer
    InFile = FreeFile
    dfile = App.Path & "\data\tipofday.txt"
    If Dir(dfile) = "" Then
        Open dfile For Output As InFile
    Else
        Open dfile For Append As InFile
    End If
    inputs = ""
    For i = 1 To Len(Text3.Text)
        ls = Mid(Text3.Text, i, 1)
        If Asc(ls) = 13 Then
            i = i + 1
            inputs = inputs + Chr(10)
        Else
            inputs = inputs + ls
        End If
    Next i
    inputs = inputs + Chr(10) + Chr(10) + "答案："
    For i = 1 To Len(Text4.Text)
        ls = Mid(Text4.Text, i, 1)
        If Asc(ls) = 13 Then
            inputs = inputs + Chr(10)
        Else
            inputs = inputs + ls
        End If
    Next i
    Write #InFile, inputs
    Close InFile
    MsgBox "已经成功将此题加如每日提示中。", vbInformation, "成功加入"
Else
    MsgBox "空记录，无法加入到提示框中去", vbExclamation, App.EXEName
End If
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim icon As String
Label1.ForeColor = &H8000000E
icon = App.Path & "\ico\hand.cur"
Label1.MouseIcon = LoadPicture(icon)
End Sub

Private Sub Text1_Change()
If presskey <> "添加" Then
    Text3.Text = Text1.Text
End If
End Sub

Private Sub Text2_Change()
If presskey <> "添加" Then
    Text4.Text = Text2.Text
End If
End Sub

Private Sub huifu()
Combo1.Enabled = Not Combo1.Enabled
Text3.Locked = Not Text3.Locked
Text4.Locked = Not Text4.Locked
Command1.Enabled = Not Command1.Enabled
Command2.Enabled = Not Command2.Enabled
Command3.Enabled = Not Command3.Enabled
Command4.Enabled = Not Command4.Enabled
Command5.Enabled = Not Command5.Enabled
Command6.Enabled = Not Command6.Enabled
Command7.Enabled = Not Command7.Enabled
Command8.Enabled = Not Command8.Enabled
Command11.Enabled = Not Command11.Enabled
Command12.Enabled = Not Command12.Enabled
Command13.Enabled = Not Command13.Enabled
Command14.Enabled = Not Command14.Enabled
Command15.Enabled = Not Command15.Enabled
Frame6.Enabled = Not Frame6.Enabled
DataGrid1.Enabled = Not DataGrid1.Enabled
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    KeyAscii = 10
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    KeyAscii = 10
End If
End Sub

Private Sub Text7_Change()
If Text7.Text <> "" And Combo1.ListIndex > 1 Then
    Text3.Text = Text1.Text + Text7.Text
End If
End Sub
Private Sub lookfor()
find1 = False
find2 = False
If Combo2(0).Text = "=" Then
    If Text1.Text = Text5.Text Then
        find1 = True
    End If
End If
If Combo2(0).Text = "包含" Then
    For j = 0 To Len(Text1.Text) - Len(Text5.Text)
        If Text5.Text = Mid(Text1.Text, j + 1, Len(Text5.Text)) Then
            find1 = True
        End If
    Next j
End If
If Combo2(0).Text = "忽略" Then
    find1 = True
End If
If Combo2(1).Text = "=" Then
    If Text2.Text = Text6.Text Then
        find2 = True
    End If
End If
If Combo2(1).Text = "包含" Then
    For j = 0 To Len(Text2.Text) - Len(Text6.Text)
        If Text6.Text = Mid(Text2.Text, j + 1, Len(Text6.Text)) Then
            find2 = True
        End If
    Next j
End If
If Combo2(1).Text = "忽略" Then
    find2 = True
End If
End Sub