Помогите доделать код!

Тема в разделе "Visual Basic", создана пользователем koyan, 21 июл 2007.

Статус темы:
Закрыта.
  1. koyan

    koyan Гость

    Din исходный код программки, как сделать чтоб вопросы на которые отвечал юзер, копировались в файл вместе с ответами?

    Private Sub BeginTest()
    Dim I As Integer, t%, temp$
    On Local Error GoTo Bug
    TaskNum = 1
    If Not IsAdmin Then
    TestSize% = ReadINI("Default", "TestSize")
    ReDim TaskOrder(1 To TestSize)
    ' определяем последовательность заданий
    For I = 1 To DataBases.rsTask.RecordCount
    temp = temp & Chr(I)
    Next
    For I = 1 To TestSize
    DoEvents
    Randomize
    t = (Len(temp) - 1) * Rnd + 1
    TaskOrder(I) = Asc(Mid(temp, t, 1))
    temp = Left(temp, t - 1) & Right(temp, Len(temp) - t)
    Next
    Timer1.Enabled = True
    Else
    TestSize = DataBases.rsTask.RecordCount
    ReDim TaskOrder(1 To TestSize)
    For I = 1 To TestSize
    TaskOrder(I) = I
    Next
    End If
    isBoolResult = ReadINI("Default", "isBoolResult")
    Mistakes = ReadINI("Default", "Mistakes")
    Timeout = Val(ReadINI("General", "Timeout"))
    Call NextTask(1)

    Exit Sub
    Bug:

    End Sub

    Private Sub NextTask(Optional Number As Integer)
    Dim I%, objList As Object

    With DataBases.rsTask
    If Number = 0 Then
    TaskNum = TaskNum + 1
    Else
    TaskNum = Number
    End If
    If TaskNum > TestSize Then
    If IsAdmin = False Then
    Call Finish
    Else
    NextTask (1)
    End If
    Exit Sub
    End If
    .MoveFirst
    .Move (TaskOrder(TaskNum) - 1)
    End With

    I = 1
    Dim Cname$, tstr$

    Do While I <= 4
    For Each objList In Me.Controls
    Cname = objList.Name
    ' Debug.Print Cname
    If Cname Like ("Check" & I) Then
    ' Debug.Print Cname
    objList.Visible = True
    If Not DataBases.rsTask.Fields(I + 1) = Empty Then
    objList.Caption = DataBases.rsTask.Fields(I + 1)
    Else
    objList.Caption = ""
    If Not IsAdmin Then: objList.Visible = False
    End If
    I = I + 1
    End If
    Next
    Loop
    lblQuestion.Caption = DataBases.rsTask.Fields(1)
    Frame1.Caption = "Задание № " & TaskNum
    RA = CStr(DataBases.rsTask.Fields(6))
    If IsAdmin And (RA Like "*1*") Then
    Check1.value = vbChecked
    Else
    Check1.value = vbUnchecked
    End If
    If IsAdmin And (RA Like "*2*") Then
    Check2.value = vbChecked
    Else
    Check2.value = vbUnchecked
    End If
    If IsAdmin And (RA Like "*3*") Then
    Check3.value = vbChecked
    Else
    Check3.value = vbUnchecked
    End If
    If IsAdmin And (RA Like "*4*") Then
    Check4.value = vbChecked
    Else
    Check4.value = vbUnchecked
    End If
    End Sub

    Private Sub imApply_Click()
    Dim temp$
    If Not IsAdmin Then
    'IsAdmin = True
    If Check1.value Then: temp = temp & 1
    If Check2.value Then: temp = temp & 2
    If Check3.value Then: temp = temp & 3
    If Check4.value Then: temp = temp & 4
    If temp = "" Or temp = "1234" Then
    Call MsgBox("Выберите от 1 до 3" & vbNewLine & "вариантов ответа", vbCritical, "Внимание!")
    Exit Sub
    ElseIf Sort(RA) = temp Then
    TaskOrder(TaskNum) = 1
    Else
    TaskOrder(TaskNum) = 0
    End If
    Else
    RA = IIf(Check1.value, 1, "")
    RA = RA & IIf(Check2.value, 2, "")
    RA = RA & IIf(Check3.value, 3, "")
    RA = RA & IIf(Check4.value, 4, "")
    If RA = "" Or RA = "1234" Then
    Call MsgBox("Выберите от 1 до 3" & vbNewLine & "вариантов ответа", vbCritical, "Внимание!")
    Exit Sub
    End If

    With DataBases.rsCards
    .Fields("Question") = Question
    .Fields("AnswerText1") = Check1.Caption
    .Fields("AnswerText2") = Check2.Caption
    .Fields("AnswerText3") = Check3.Caption
    .Fields("AnswerText4") = Check4.Caption
    .Fields("RA") = RA
    .Fields("Path") = Path
    .Update
    End With
    End If
    Call NextTask
    End Sub
     
  2. Gamlet

    Gamlet Well-Known Member

    Регистрация:
    8 янв 2007
    Сообщения:
    609
    Симпатии:
    0
    Устрой массивами. Один массив вопросов, другой -ответов. И пусть записываются почередно. :D
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей