Нужно сделать следующее: что бы можно было добавлять тесты программно и что бы общее количество вопросов можно было менять по желанию. Вся надежда на вас парни! Сил уже нету!
Вот код программы:
Вот код программы:
Код:
unit Unit21;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, jpeg, ExtCtrls, StdCtrls, CheckLst, Menus;typeTForm21 = class(TForm)Name_label: TLabel; //Надпись куда выводися название тестаQuest_label: TLabel; //Надпись с вопросомListBox1: TListBox; //Список вариантов ответовResult_label: TLabel; //надпись с результатомImage1: TImage; //фоновый рисунокListBox2: TListBox;Next_btn: TButton; //кнопка "далее"Exit_btn: TButton; //кнопка "выход"To_main_btn: TButton;MainMenu1: TMainMenu;N2221: TMenuItem; //кнопка "на главную"// ниже идут процедурыprocedure FormCreate(Sender: TObject);procedure ListBox1Click(Sender: TObject);procedure Next_btnClick(Sender: TObject);procedure Exit_btnClick(Sender: TObject);procedure To_main_btnClick(Sender: TObject);procedure ListBox2DblClick(Sender: TObject);procedure ListBox1DblClick(Sender: TObject);procedure N21Click(Sender: TObject);procedure N2221Click(Sender: TObject);private{ Private declarations }public{ Public declarations }end;const test_file_name='base.txt'; //константа с именем файла в котором хранятся тестыvarForm21: TForm21;base:Text; //файл с тестами//тип Text- текстовый файлcurrent_quest,quest_count,answer_mark,current_mark:integer;//current_quest-номер текущего вопроса//quest_count-номер теста//answer_mark-оценка за данный ответ//current_mark-текущая оценка(без оценки за данный ответ)current_test_name,current_marks,current_quest_name:string;//current_test_name-название текущего теста//current_marks-строка в которой хранятся оценки наданный вопрос//выглядит примерно так : ",1,5,12,3," - где 1 оценка за 1-ый ответ// 5 за 2-ой, 12 за 3-ий,3за 4-ый//current_quest_name-данный вопросimplementationusesunit1;{$R *.dfm}//процедула для пероброзования очень длинной строки//в место одного сплошного рядка идет несколько, в каждом примерно по 80 буквprocedure formatstring(var s:string);var p,i:integer;beginif length(s)>80 then //если длина строки > 80beginp:=0; //номер текущего рядаfor i:=1 to length(s) doif (i) div 80p then //если целая часть при//делении номер текущего символа на 80 не ровняется тек. ном. ряд. тоif s=' ' then //проверяем что бы перенос был токо с " ", для того что бы небыло обрыва словаbeginp:=i div 80;//меняем номер рядкаinsert(#13#10,s,i);//вставляем в строку после символа под номером "i" разделитель//#13#10 - символ обозначающий перенос на новый рядокend;end;end;//процедура для загрузки списка тестовprocedure LoadTestList;var s:string;beginreset(base);//открываем базу для чтенияForm21.ListBox2.Clear;//очищаем списоп вопросов(ListBox2)while not eof(base) do //пока не конец файлаbeginreadln(base,s); //читаем строкуif copy(s,1,6)='/Test:' then //если первые шесть символов = /Test:beginreadln(base,s); //то читаем следуйшую строкуForm21.ListBox2.Items.Add(s);//и добовляем в список тестовend;end;closefile(base); //запрываем файлend;//процедура для загрузки тестов (name-название теса)procedure LoadTest(name:string);var s:string;m:integer;beginreset(base); //открываем базу для чтенияwhile not eof(base) dobeginreadln(base,s); //читаем строкуif copy(s,1,6)='/Test:' then //если первые шесть символов = /Test: тоbeginm:=strtoint(copy(s,7,length(s)-6)); //запоминаем количество вопросов//кол-во вопросов- это число после "/Test:"// strtoint функция для перевода типа string в integerreadln(base,s);//читаем следуйшую строкуif s=name then //если прочитаная строка ровняется вопросу тоbegincurrent_test_name:=s;//запоминаем имя тестаform21.Name_label.Caption:=s;//выводим имя тестаquest_count:=m;//запоминаем кол-во вопросовcurrent_mark:=0;//текущая оценка =0end;end;end;closefile(base); //закрываем файл(базу)end;//процедура для загрузки вопросов (number-номер вопроса)procedure Loadquest(number:integer);var s,s2:string;m,i,n:integer;beginreset(base); //открываем базу для чтенияwhile not eof(base) dobeginreadln(base,s);//читаем строкуif copy(s,1,6)='/Test:' then //если первые шесть символов = /Test: тоbeginreadln(base,s); //читаем строкуif s=current_test_name then //если прочитаная строка ровняется текущему вопросу тоbegini:=0 ; //обнуляем сщетчикwhile i
Последнее редактирование: