|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
тестирующая программа
срочно нужна тестирующая программа. вопросы произвольно. главное чтобы после завершения тестирования выдавалась оценка по пятибальной шкале. Заранее спасибо. . сама программа у меня есть, нужна только команда для того, чтобы выдавало в конце оценку.
Последний раз редактировалось maksim24680, 28.09.2009 в 19:53. |
#2
|
||||
|
||||
Код:
ShowMessage('Это пять!'); |
#3
|
|||
|
|||
такое дело. в тесте 10 вопросов. в каждом по 4 варианта ответа.например при выборе правильного ответа должно начисляться 0.5 балла, при неправильном 0 баллов и чтобы в конце программы выдало результат.
|
#4
|
|||
|
|||
Текста программы не вижу, так что буду предполагать и импровизировать
Допустим программа подобна тестированию в ГАИ (вводишь правильную цифру нажимаешь Enter). Тогда код примерно следующий: Код:
// i - счётчик правильных ответов // n - кол-во вопросов i := 0; далее идут вопросы, каждый вопрос примерно следующего вида // правильный ответ 1, допустим if Edit1.Text= '1' then i := i + 0.5; //вопросы закончились далее пишем ShowMessage('Оценка' + FloatToStr(10*i/n)); |
#5
|
|||
|
|||
Ну, например, это делается примерно так:
Базовые классы: Код:
unit Questions; interface uses Windows, SysUtils, Classes, Contnrs; type TQuestion = class private FText : String; FItems : TStringList; FRight : Integer; procedure SetRight(const Value: Integer); protected function ReadString(AStream : TStream) : String; procedure WriteString(AStream : TStream; AData : String); public constructor Create; destructor Destroy; override; procedure Save(AStream : TStream); procedure Load(AStream : TStream); property Text : String read FText write FText; property Items : TStringList read FItems; property Right : Integer read FRight write SetRight; end; TTest = class private FItems : TObjectList; function GetCount: Integer; function GetItem(Index: Integer): TQuestion; public constructor Create; destructor Destroy; override; procedure Save(AFileName : String); procedure Load(AFileName : String); procedure Add(AQuestion : TQuestion); procedure Delete(AIndex : Integer); procedure Remove(AQuestion : TQuestion); function Check : Boolean; property Count : Integer read GetCount; property Items[Index : Integer] : TQuestion read GetItem; end; implementation { TQuestion } constructor TQuestion.Create; begin inherited; FItems := TStringList.Create; end; destructor TQuestion.Destroy; begin FItems.Free; inherited; end; procedure TQuestion.Load(AStream: TStream); begin FText := ReadString(AStream); FItems.Text := ReadString(AStream); AStream.ReadBuffer(FRight,SizeOf(Integer)); end; function TQuestion.ReadString(AStream: TStream): String; var N : Integer; begin AStream.ReadBuffer(N,SizeOf(Integer)); If N > 0 Then Begin SetLength(Result,N); AStream.ReadBuffer(Result[1],N); End; end; procedure TQuestion.Save(AStream: TStream); begin WriteString(AStream,FText); WriteString(AStream,FItems.Text); AStream.WriteBuffer(FRight,SizeOf(Integer)); end; procedure TQuestion.SetRight(const Value: Integer); begin If (Value <> 0) And (Value >= FItems.Count) Then Raise Exception.Create('Номер правильного ответа больше, чем их общее кол-во.'); FRight := Value; end; procedure TQuestion.WriteString(AStream: TStream; AData: String); var N : Integer; begin N := Length(AData); AStream.WriteBuffer(N,SizeOf(Integer)); If N > 0 Then AStream.WriteBuffer(AData[1],N); end; { TTest } procedure TTest.Add(AQuestion: TQuestion); begin FItems.Add(AQuestion); end; constructor TTest.Create; begin inherited; FItems := TObjectList.Create(True); end; procedure TTest.Delete(AIndex: Integer); begin FItems.Delete(AIndex); end; procedure TTest.Remove(AQuestion: TQuestion); begin FItems.Remove(AQuestion); end; destructor TTest.Destroy; begin FItems.Free; inherited; end; function TTest.GetCount: Integer; begin Result := FItems.Count; end; function TTest.GetItem(Index: Integer): TQuestion; begin Result := FItems[Index] As TQuestion; end; procedure TTest.Load(AFileName: String); var N, I : Integer; AStream : TFileStream; AQuestion : TQuestion; begin FItems.Clear; AStream := TFileStream.Create(AFileName,fmOpenRead); Try N := 0; AStream.ReadBuffer(N,SizeOf(Integer)); For I := 0 To N-1 Do Begin AQuestion := TQuestion.Create; AQuestion.Load(AStream); FItems.Add(AQuestion); End; Finally AStream.Free; End; end; procedure TTest.Save(AFileName: String); var N, I : Integer; AStream : TFileStream; begin AStream := TFileStream.Create(AFileName,fmCreate); Try N := Count; AStream.WriteBuffer(N,SizeOf(Integer)); For I := 0 To N-1 Do Items[i].Save(AStream); Finally AStream.Free; End; end; function TTest.Check: Boolean; var I : Integer; begin Result := True; For I := 0 To FItems.Count-1 Do Begin Result := (Items[i].Items.Count > 0) And (Items[i].Right >= 0) And (Items[i].Right < Items[i].Items.Count); If Not Result Then Exit; End; end; end. Собственно программа (главная форма): Код:
unit MainFrm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, XPMan, Questions; type TMainForm = class(TForm) pcBody: TPageControl; tsBegin: TTabSheet; tsQuestions: TTabSheet; tsResult: TTabSheet; lbGreeting: TLabel; edName: TEdit; lbButtons: TLabel; btBegin: TButton; btClose: TButton; XPManifest1: TXPManifest; gbQuestion: TGroupBox; gbAnswers: TRadioGroup; btNext: TButton; lbText: TLabel; lbConfirm: TLabel; btYes: TButton; btNo: TButton; lbResult: TLabel; procedure FormCreate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure btCloseClick(Sender: TObject); procedure edNameChange(Sender: TObject); procedure gbAnswersClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure btBeginClick(Sender: TObject); procedure btNextClick(Sender: TObject); procedure btNoClick(Sender: TObject); procedure btYesClick(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); private { Private declarations } FTest : TTest; FRightAns : Integer; FCurrQuestion : Integer; procedure ShowQuestion; public { Public declarations } end; var MainForm: TMainForm; implementation {$R *.dfm} procedure TMainForm.FormCreate(Sender: TObject); var AFileName : String; begin FTest := TTest.Create; AFileName := ExtractFilePath(Application.ExeName) + 'SimpleTest.db'; If FileExists(AFileName) Then FTest.Load(AFileName) Else Begin MessageDlg('Файл базы вопросов SimpleTest.db не найден. Выполнение программы невозможно.',mtError,[mbOK],0); Halt(1); End; If FTest.Count = 0 Then Begin MessageDlg('Файл базы вопросов SimpleTest.db содержит 0 вопросов. Выполнение программы невозможно.',mtError,[mbOK],0); Halt(2); End; pcBody.ActivePage := tsBegin; tsBegin.TabVisible := True; tsQuestions.TabVisible := False; tsResult.TabVisible := False; end; procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin If pcBody.ActivePage = tsQuestions Then CanClose := MessageDlg('Вы действительно хотите прервать тест?',mtConfirmation,[mbYes,mbNo],0) = mrYes Else CanClose := True; end; procedure TMainForm.btCloseClick(Sender: TObject); begin Close; end; procedure TMainForm.edNameChange(Sender: TObject); begin btBegin.Enabled := edName.Text <> ''; end; procedure TMainForm.gbAnswersClick(Sender: TObject); begin btNext.Enabled := gbAnswers.ItemIndex > -1; end; procedure TMainForm.FormDestroy(Sender: TObject); begin FTest.Free; end; procedure TMainForm.btBeginClick(Sender: TObject); begin FRightAns := 0; FCurrQuestion := -1; tsQuestions.TabVisible := True; pcBody.ActivePage := tsQuestions; tsBegin.TabVisible := False; ShowQuestion; end; procedure TMainForm.ShowQuestion; begin If FCurrQuestion > -1 Then Begin If gbAnswers.ItemIndex = -1 Then Exit; If gbAnswers.ItemIndex = FTest.Items[FCurrQuestion].Right Then Inc(FRightAns); End; Inc(FCurrQuestion); If FCurrQuestion >= FTest.Count Then Begin tsResult.TabVisible := True; pcBody.ActivePage := tsResult; tsQuestions.TabVisible := False; lbResult.Caption := 'Тестируемый: '+edName.Text+#13#10+ 'Всего задано вопросов: ' + IntToStr(FTest.Count)+#13#10+ 'Отвечено правильно: ' + IntToStr(FRightAns)+#13#10+ 'Отвечено неправильно: ' + IntToStr(FTest.Count - FRightAns)+#13#10+ Format('Процент правильных ответов: %.2f%%',[100*FRightAns/FTest.Count]); End Else Begin tsQuestions.Caption := Format('Вопрос %d из %d',[FCurrQuestion + 1,FTest.Count]); lbText.Caption := FTest.Items[FCurrQuestion].Text; gbAnswers.ItemIndex := -1; gbAnswers.Items.Text := FTest.Items[FCurrQuestion].Items.Text; btNext.Enabled := gbAnswers.ItemIndex <> -1; End; end; procedure TMainForm.btNextClick(Sender: TObject); begin ShowQuestion; end; procedure TMainForm.btNoClick(Sender: TObject); begin Close; end; procedure TMainForm.btYesClick(Sender: TObject); begin tsBegin.TabVisible := True; tsQuestions.TabVisible := False; tsResult.TabVisible := False; pcBody.ActivePage := tsBegin; end; procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char); begin If Key = #13 Then Begin If (pcBody.ActivePage = tsQuestions) And (btNext.Enabled) Then btNextClick(Sender); End; end; end. Делал для одного человека... Оценка, кажется, не считается (не помню уже), но это дописать не сложно. |
#6
|
|||
|
|||
вот моя программа: могу на мыло прислать саму программу Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; RadioButton1: TRadioButton; RadioButton2: TRadioButton; RadioButton3: TRadioButton; RadioButton4: TRadioButton; RadioButton8: TRadioButton; RadioButton9: TRadioButton; RadioButton10: TRadioButton; Label2: TLabel; RadioButton5: TRadioButton; Button2: TButton; Label1: TLabel; Button3: TButton; Button4: TButton; Button5: TButton; Label3: TLabel; RadioButton6: TRadioButton; RadioButton7: TRadioButton; RadioButton11: TRadioButton; RadioButton12: TRadioButton; Label4: TLabel; RadioButton13: TRadioButton; RadioButton14: TRadioButton; RadioButton15: TRadioButton; RadioButton16: TRadioButton; Button6: TButton; Button7: TButton; Button8: TButton; Button9: TButton; Label5: TLabel; RadioButton17: TRadioButton; RadioButton18: TRadioButton; RadioButton19: TRadioButton; RadioButton20: TRadioButton; Label6: TLabel; RadioButton21: TRadioButton; RadioButton22: TRadioButton; RadioButton23: TRadioButton; RadioButton24: TRadioButton; Label7: TLabel; RadioButton25: TRadioButton; RadioButton26: TRadioButton; RadioButton27: TRadioButton; RadioButton28: TRadioButton; Label8: TLabel; RadioButton29: TRadioButton; RadioButton30: TRadioButton; RadioButton31: TRadioButton; RadioButton32: TRadioButton; Label9: TLabel; RadioButton33: TRadioButton; RadioButton34: TRadioButton; RadioButton35: TRadioButton; RadioButton36: TRadioButton; Label10: TLabel; RadioButton37: TRadioButton; RadioButton38: TRadioButton; RadioButton39: TRadioButton; RadioButton40: TRadioButton; Button10: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Button7Click(Sender: TObject); procedure Button8Click(Sender: TObject); procedure Button9Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin RadioButton1.visible:=false; RadioButton2.visible:=false; RadioButton3.visible:=false; RadioButton4.visible:=false; RadioButton10.visible:=true; RadioButton9.visible:=true; RadioButton8.visible:=true; RadioButton5.visible:=true; Label1.Visible:=false; Label2.Visible:=true; Button1.Visible:=false; Button2.Visible:=true; end; procedure TForm1.Button2Click(Sender: TObject); begin RadioButton10.visible:=false; RadioButton9.visible:=false; RadioButton8.visible:=false; RadioButton5.visible:=false; RadioButton6.visible:=true; RadioButton7.visible:=true; RadioButton11.visible:=true; RadioButton12.visible:=true; Button2.Visible:=false; Button3.Visible:=true; Label2.Visible:=false; Label3.Visible:=true; end; procedure TForm1.Button3Click(Sender: TObject); begin RadioButton6.visible:=false; RadioButton7.visible:=false; RadioButton11.visible:=false; RadioButton12.visible:=false; RadioButton13.visible:=true; RadioButton14.visible:=true; RadioButton15.visible:=true; RadioButton16.visible:=true; Label3.Visible:=false; Label4.Visible:=true; Button3.Visible:=false; Button4.Visible:=true; end; procedure TForm1.Button4Click(Sender: TObject); begin RadioButton13.visible:=false; RadioButton14.visible:=false; RadioButton15.visible:=false; RadioButton16.visible:=false; RadioButton17.visible:=true; RadioButton18.visible:=true; RadioButton19.visible:=true; RadioButton20.visible:=true; Label4.Visible:=false; Label5.Visible:=true; Button4.Visible:=false; Button5.Visible:=true; end; procedure TForm1.Button5Click(Sender: TObject); begin RadioButton17.visible:=false; RadioButton18.visible:=false; RadioButton19.visible:=false; RadioButton20.visible:=false; RadioButton21.visible:=true; RadioButton22.visible:=true; RadioButton23.visible:=true; RadioButton24.visible:=true; Label5.Visible:=false; Label6.Visible:=true; Button5.Visible:=false; Button6.Visible:=true; end; procedure TForm1.Button6Click(Sender: TObject); begin RadioButton21.visible:=false; RadioButton22.visible:=false; RadioButton23.visible:=false; RadioButton24.visible:=false; RadioButton25.visible:=true; RadioButton26.visible:=true; RadioButton27.visible:=true; RadioButton28.visible:=true; Label6.Visible:=false; Label7.Visible:=true; Button6.Visible:=false; Button7.Visible:=true; end; procedure TForm1.Button7Click(Sender: TObject); begin RadioButton25.visible:=false; RadioButton26.visible:=false; RadioButton27.visible:=false; RadioButton28.visible:=false; RadioButton29.visible:=true; RadioButton30.visible:=true; RadioButton31.visible:=true; RadioButton32.visible:=true; Label7.Visible:=false; Label8.Visible:=true; Button7.Visible:=false; Button8.Visible:=true; end; procedure TForm1.Button8Click(Sender: TObject); begin RadioButton29.visible:=false; RadioButton30.visible:=false; RadioButton31.visible:=false; RadioButton32.visible:=false; RadioButton33.visible:=true; RadioButton34.visible:=true; RadioButton35.visible:=true; RadioButton36.visible:=true; Label8.Visible:=false; Label9.Visible:=true; Button8.Visible:=false; Button9.Visible:=true; end; procedure TForm1.Button9Click(Sender: TObject); begin RadioButton33.visible:=false; RadioButton34.visible:=false; RadioButton35.visible:=false; RadioButton36.visible:=false; RadioButton37.visible:=true; RadioButton38.visible:=true; RadioButton39.visible:=true; RadioButton40.visible:=true; Label9.Visible:=false; Label10.Visible:=true; Button9.Visible:=false; Button10.Visible:=true end; end. lmikle: Пользуемся тегами!!! |
#7
|
|||
|
|||
maksim24680, ну ты маньяк!!!
Посмотри что из себя представляет контрол TRadioGroup. И е надо будет ваять сто тыщ радиобутонов. Ну или посмотри как сделано в моем коде. |