Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 09.04.2014, 13:58   #1
skywalker29
Новичок
Джуниор
 
Регистрация: 14.04.2013
Сообщений: 1
Восклицание Delphi не могу найти ошибку!!!

Всем привет,тема конечно изъезженная,но мне понадобился тест,что бы долго не фантазировать,взял за основу исходник из интернета.Переделал все под себя,НО прослеживается такой косяк,имеется 2 .txt файла (теста) в одном 15(назовем его B) вопросов в другом 7(назовем его С),при запуске программы если сначала проходим тест С ,по завершению он выдает результат и все хорошо.А если пройти сначала тест B ,а потом C то он не завершает его ,а добавляет вопросы из теста B до 15..получается так,1-7 вопрос из теста С и с 8-15 из теста B...мучаюсь уже пару дней,все перепробовал,ничего не помогает..свежий взгляд и ваше мнение мне может помочь.
Код HTML:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg;

type
  TForm1 = class(TForm)
    Button1: TButton;
    AnswerGroup: TRadioGroup;
    GroupBox1: TGroupBox;
    Question: TLabel;
    TestBox: TComboBox;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure LoadQuestion(Index: integer);
    procedure FormCreate(Sender: TObject);
    procedure LoadTest(Index: integer);
    procedure TestBoxCloseUp(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
  public
  end;

const
  TestName='Test_'; // имя файла теста
  max=1000; // максимальное количесво вопросов
var
  Form1: TForm1;
  QuestionText: array [0..max] of string; // текст вопроса
  AnswerQuestion: array [0..max] of byte; // правильный вариант ответа
  QuestionText1: array [0..max] of string;// первый вопрос
  QuestionText2: array [0..max] of string;// второй вопрос
  QuestionText3: array [0..max] of string;// третий вопрос
  Ball: integer=0;                        // оценка
  now: integer=0;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if AnswerQuestion[now]=AnswerGroup.ItemIndex+1 then  // сравниваем значение ответа и выбранного значения
  inc(ball);
  AnswerGroup.ItemIndex:=-1;  // убираем выдаление с группы ответов
  inc(now);                   // увеличиваем вопрос на 1+
  LoadQuestion(now);          // загружаем его
end;

procedure TForm1.LoadQuestion(Index: integer);
begin
 if QuestionText[Index]<>'' then// если выбранный вопрос существует то грузим его
  begin
  AnswerGroup.Items.Clear;// очищаем поле ответов
  Question.Caption:=QuestionText[Index];// задаем запрос
  AnswerGroup.Items.Add(QuestionText1[index]);// добавляем ответ
  AnswerGroup.Items.Add(QuestionText2[index]); // добавляем ответ
  AnswerGroup.Items.Add(QuestionText3[index]);  // добавляем ответ
  end
  else // иначе сообщаем что тест завершен
  begin
  showmessage('Тест завершен'+#13+'Правильных ответов: '+inttostr(ball)); // сообщение что тест окончен и выдаем количесво правильных ответов
  button1.Enabled:=false; // делаем неактивной кнопку
  button2.Enabled:=true; // включаем справку
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  s: Tstrings;
  i: Integer;
begin
  i:=0;
  while FileExists(ExtractFilePath(application.ExeName)+TestName+inttostr(i)+'.txt') do  // проверяем файлы тестов
  begin
  application.ProcessMessages;  // что б не тормозило
  s:=tstringlist.Create;        // создаем переменную
  s.LoadFromFile(ExtractFilePath(application.ExeName)+TestName+inttostr(i)+'.txt'); // загружаем файл
    if s.Text<>'' then  // если не пуст то
    TestBox.Items.Add(s.Strings[0]); // добавляем в группу тестов название теста
  s.Free;  // уничтожаем переменную
  inc(i);  // увеличиваем счетчик
  end;
end;

procedure TForm1.LoadTest(Index: integer);
var
  s: Tstrings;
  j, h: Integer;
begin
  h:=0;
  s:=tstringlist.Create;  // создаем переменную
  s.LoadFromFile(ExtractFilePath(application.ExeName)+TestName+inttostr(Index)+'.txt'); // загружаем
    if s.Text<>'' then  // если не пустая то
    begin
    form1.Caption:=s.Strings[0]; // название теста
      for j := 1 to s.Count - 1 do // начинаем присваивать значения
      begin
        if s.Strings[j]='__________' then  // это разделитель который мы ищем
        begin
        QuestionText[h]:=s.Strings[j+1]; // текст вопроса
        QuestionText1[h]:=s.Strings[j+2];// текст первого вариант ответа
        QuestionText2[h]:=s.Strings[j+3];// текст второго варианта ответа
        QuestionText3[h]:=s.Strings[j+4];// текст третьего варианта ответа
        AnswerQuestion[h]:=strtoint(s.Strings[j+5]); // номер ответа
        inc(h); // увеличиваем счетчик для того что бы записывать в новый элемент массива

        end
      end;
    end;
  s.Free; // уничтожаем переменную
  LoadQuestion(now);// загружаем вопрос здесь он всегда = 0
end;

procedure TForm1.TestBoxCloseUp(Sender: TObject);
begin
  ball:=0;
  now:=0;
  button1.Enabled:=true;
  button2.Enabled:=false;
  LoadTest(TestBox.ItemIndex);
end;
end.
Исходник: testovik.rar
skywalker29 вне форума Ответить с цитированием
Старый 09.04.2014, 14:44   #2
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

Код:
if QuestionText[Index]<>'' then// если выбранный вопрос существует то грузим его
Нужно не содержимое массива сравнивать (оно не пустое от предыдущей загрузки), а Index c кол-вом загруженных вопросов в последнем тесте
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не могу найти ошибку proxex Общие вопросы Delphi 3 10.01.2013 16:59
Delphi 7.0 Записи. Не могу найти ошибку в процедуре Nerotim Помощь студентам 1 28.11.2012 10:40
не могу найти ошибку Nix128 Microsoft Office Excel 8 24.05.2011 15:05
Delphi не могу найти ошибку..... world12_tk Помощь студентам 2 10.10.2009 15:19
Delphi. Не могу найти ошибку. Армана Помощь студентам 4 23.02.2009 23:34