тестирующая программа

maksim24680 · #1 28.09.2009, 17:36

срочно нужна тестирующая программа. вопросы произвольно. главное чтобы после завершения тестирования выдавалась оценка по пятибальной шкале. Заранее спасибо.

. сама программа у меня есть, нужна только команда для того, чтобы выдавало в конце оценку.

TOJluK · #2 29.09.2009, 14:41

Код:

ShowMessage('Это пять!');

Может как- то поподробнее расскажете чего и куда вам надо выдавать?

maksim24680 · #3 29.09.2009, 17:42

такое дело. в тесте 10 вопросов. в каждом по 4 варианта ответа.например при выборе правильного ответа должно начисляться 0.5 балла, при неправильном 0 баллов и чтобы в конце программы выдало результат.

Boris the Blade · #4 30.09.2009, 14:57

Текста программы не вижу, так что буду предполагать и импровизировать

Допустим программа подобна тестированию в ГАИ (вводишь правильную цифру нажимаешь Enter). Тогда код примерно следующий:

Код:

// i - счётчик правильных ответов
// n - кол-во вопросов
i := 0;

далее идут вопросы, каждый вопрос примерно следующего вида

// правильный ответ 1, допустим
if Edit1.Text= '1' then
i := i + 0.5;

//вопросы закончились далее пишем
ShowMessage('Оценка' + FloatToStr(10*i/n));

lmikle · #5 30.09.2009, 16:39

Ну, например, это делается примерно так:

Базовые классы:

Код:

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.

Делал для одного человека...
Оценка, кажется, не считается (не помню уже), но это дописать не сложно.

maksim24680 · #6 30.09.2009, 19:31

вот моя программа:

могу на мыло прислать саму программу

Код:

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: Пользуемся тегами!!!

lmikle · #7 30.09.2009, 19:47

maksim24680, ну ты маньяк!!!
Посмотри что из себя представляет контрол TRadioGroup. И е надо будет ваять сто тыщ радиобутонов. Ну или посмотри как сделано в моем коде.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты