frmjianda.frm

来自「vb试卷生成系统！能够生成8开vb考试试卷」· FRM 代码 · 共 1,100 行 · 第 1/3 页

Private Sub Command14_Click()
presskey = "移动"
If Text1.Text = "" Or recordc2 = 1 Then
Else
    recordnum2 = adodc1.Recordset.RecordCount
    adodc1.Recordset.MoveLast
End If
stats = "当前记录：" + Str(recordnum2) + "/" + Str(recordc2) + "    浏览状态"
fMainForm.sbStatusBar.Panels(1).Text = stats
End Sub

Public Sub Command15_Click()
Dim biao As String
biao = "yxuanze" + Trim(Str(Combo1.ListIndex + 9))
Adodc3.RecordSource = biao
Adodc3.Refresh
Adodc2.RecordSource = "select * from " + biao + " where " + "neirong= '" + Text1.Text + "'"
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
    MsgBox "成功加入考题试卷中。", vbInformation, App.EXEName
    Adodc3.Recordset.Update
Else
    MsgBox "试卷中己有此题,或试图加入空记录！加入失败。", vbInformation, App.EXEName
End If
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 = "" Then
    MsgBox "题目未填写完整，请继续填写。", vbInformation, "无法更新"
    Text3.SetFocus
Else
linkku = "jiandati" + Trim(Str(Combo1.ListIndex + 1))
Adodc4.RecordSource = "select * from " + linkku + " where neirong='" + Text3.Text + "'"
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
    recordc2 = recordc2 + 1
    recordnum2 = recordc2
    adodc1.Recordset.AddNew
End If
lsneirong = Text3.Text
textnum = 0
Text1.Text = ""
For i = 1 To Len(lsneirong)
    If textnum <= 250 Then
        Text1.Text = Text1.Text + Mid(lsneirong, i, 1)
        If Asc(Mid(lsneirong, i, 1)) < 0 Then
            textnum = textnum + 2
        Else
            textnum = textnum + 1
        End If
    Else
        MsgBox "你输入的数据太长无法完全存入题库中，多余的将被截去。", vbExclamation, App.EXEName
        Exit For
    End If
Next i
Text2.Text = Text4.Text
Text1.SetFocus
Text2.SetFocus
adodc1.Recordset.MovePrevious
adodc1.Recordset.MoveNext
huifu
End If
stats = "当前记录：" + Str(recordnum2) + "/" + Str(recordc2) + "    浏览状态"
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(recordnum2) + "/" + Str(recordc2) + "    浏览状态"
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(recordnum2) + "/" + Str(recordc2) + "    修改状态"
    fMainForm.sbStatusBar.Panels(1).Text = stats
    Text3.SetFocus
End If
End Sub
Public Sub Command8_Click()
If recordc2 >= 1 Then
presskey = "删除"
tuichu = MsgBox("确定此题吗？", vbYesNo + vbQuestion, "确认？")
If tuichu = 6 Then
    adodc1.Recordset.Delete
    recordc2 = recordc2 - 1
    If recordc2 < recordnum2 Then
        recordnum2 = recordc2
    End If
End If
If recordnum2 = 0 Then
    stats = "当前记录：BOF/EOF"
Else
    stats = "当前记录：" + Str(recordnum2) + "/" + Str(recordc2) + "    浏览状态"
End If
fMainForm.sbStatusBar.Panels(1).Text = stats
End If
End Sub

Private Sub Command9_Click()
If recordnum2 = 1 Then
    MsgBox "己到记录首", vbInformation, "查询"
Else
For i = recordnum2 - 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
    recordnum2 = DataGrid1.GetBookmark(0)
    If recordnum2 > recordc2 Then
        recordnum2 = recordc2
    End If
    stats = "当前记录：" + Str(recordnum2) + "/" + Str(recordc2) + "    浏览状态"
    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
recordc2 = adodc1.Recordset.RecordCount
If recordc2 >= 1 Then
    recordnum2 = 1
    adodc1.Recordset.Move (0)
Else
    recordnum2 = 0
End If
stats = "当前记录：" + Str(recordnum2) + "/" + Str(recordc2) + "    浏览状态"
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 = "jiandati1"
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_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label1.ForeColor = &H0&
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
Public Sub Label1_Click()
If recordc2 <> 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 midstring(str1 As String, str2 As String, result As Boolean)
If Len(str1) > Len(str2) Then
    result = False
    Exit Sub
End If
For i = 0 To Len(str2) - Len(str1)
    If str1 = Mid(str2, i + 1, Len(str1)) Then
        result = True
        Exit Sub
    End If
Next i
result = False
End Sub

Private Sub Text7_Change()
If Text7.Text <> "" Then
    Text3.Text = Text3.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