Рефераты - Афоризмы - Словари
Русские, белорусские и английские сочинения
Русские и белорусские изложения
 

Создание теста в Delphi

Работа из раздела: «Программирование и комп-ры»

Приложение
      unit fmain;

      interface

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

      type
        TFormmain = class(TForm)
          Edit1: TEdit;
          StaticText1: TStaticText;
          Edit2: TEdit;
          StaticText2: TStaticText;
          ComboSex: TComboBox;
          StaticText3: TStaticText;
          StaticText4: TStaticText;
          ComboAge: TComboBox;
          Button1: TButton;
          Button2: TButton;
          procedure Button1Click(Sender: TObject);
          procedure Button2Click(Sender: TObject);
          procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
        private
          { Private declarations }
        public
          { Public declarations }
        end;

      var
        Formmain: TFormmain;

      implementation

      uses ftest;

      {R *.dfm}

      procedure TFormmain.Button1Click(Sender: TObject);
      var error:Boolean;
      begin
      nomer:=0;
      if edit1.Text='' then
      begin messagedlg('Введите фамилию',mterror,[mbok],0);
      error:=true; end else error:=false;
      if edit2.Text='' then
      begin messagedlg('Введите имя',mterror,[mbok],0);
      error:=true; end else error:=false;
      if ComboSex.ItemIndex<>0 then
                      if ComboSex.ItemIndex<>1 then
                                                  begin  messagedlg('Введите
пол',mterror,[mbok],0);
                                                   error:=true;   end   else
error:=false;
      if ComboAge.ItemIndex<>0 then
                      if ComboAge.ItemIndex<>1 then
                           if ComboAge.ItemIndex<>2 then
                                                  begin  messagedlg('Введите
возраст',mterror,[mbok],0);
                                                   error:=true;   end   else
error:=false;
      if error=false then begin
      Formmain.hide;
      formtest.Show;
      end;
      end;

      procedure TFormmain.Button2Click(Sender: TObject);
      begin
      close;
      end;

      procedure  TFormmain.FormCloseQuery(Sender:  TObject;  var   CanClose:
Boolean);
      begin
      if           messagedlg('Вы            действительно            хотите
выйти?',mtcustom,[mbyes,mbno],0)=mrno then
      canclose:=false;
      end;

      end.



      unit ftest;

      interface

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

      type
        TFormTest = class(TForm)
          buttonnext: TButton;
          Memo1: TMemo;
          RadioGroup1: TRadioGroup;
          Label1: TLabel;
          Label3: TLabel;
          BFinish: TButton;
          procedure buttonnextClick(Sender: TObject);
          procedure FormCreate(Sender: TObject);
          procedure buttonPreviosClick(Sender: TObject);
          procedure FormClose(Sender: TObject; var Action: TCloseAction);
          procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
          procedure BFinishClick(Sender: TObject);
          procedure FormHide(Sender: TObject);
          procedure FormDblClick(Sender: TObject);
        private
          { Private declarations }
        public
          { Public declarations }
        end;

      var
        FormTest: TFormTest;
        nomer:Byte; {номер вопроса}
        a,b,c,d,e,f,g,h,i,l,m,n,o,q1,q2,q3,q4:byte;{Факторы}
        aa,bb,cc,dd,ee,ff,gg,hh,ii,ll,mm,nn,oo,qq1,qq2,qq34:byte;{Стены}
      implementation

      uses fmain;

      {R *.dfm}

      {Очистка формы}
      procedure clear;
      begin
      FormTest.Memo1.Lines.Clear;
      FormTest.RadioGroup1.Items.Clear;
      end;

      procedure pballov;
      begin
      if nomer=3 then
            begin
              case FormTest.RadioGroup1.ItemIndex of
                                       0:begin Aa:=aa+2;bb:=bb+2;end;
                                       1:begin aa:=aa+1;bb:=bb+1;end;
                                       2:begin aa:=aa+2;bb:=bb+2;end;
                                    end;
            end;
      case nomer of
       {AA} 27,52,76,101,126,151,176:begin
                                    case FormTest.RadioGroup1.ItemIndex of
                                       0:Aa:=aa+2;
                                       1:aa:=aa+1;
                                       2:aa:=aa+2;
                                    end;
                                  end;
       {BB} 28,54,78,103,128,153,178:begin
                                    case FormTest.RadioGroup1.ItemIndex of
                                       0:bb:=bb+2;
                                       1:bb:=bb+1;
                                       2:bb:=bb+2;
                                    end;
                                  end;

      ...

      {QQ3 и QQ4}  24,48,73,98,123,148,173:begin
                                    case FormTest.RadioGroup1.ItemIndex of
                                       0:qq34:=qq34+2;
                                       1:qq34:=qq34+1;
                                       2:qq34:=qq34+2;
                                    end;
                                  end;
      end;
      FormTest.RadioGroup1.ItemIndex:=-1;
      end;

      {Подсчёт вывод и сохранение результата }
      procedure whoru;
      begin
      clear;
      {подсчёт всех факторов}
      case formmain.ComboAge.ItemIndex of{от 16 до 18 лет}
       0:begin
         if formmain.ComboSex.ItemIndex=0 then {Ж.}
             begin
              case aa of
              0..6:a:=1;
              7..8:a:=3;
              9..10:a:=4;
              11:a:=5;
              12..13:a:=6;
              14..15:a:=7;
              16:a:=8;
              17..18:a:=9;
              19..20:a:=10;
              end;
               case bb of
               0..1:b:=1;
               8,9:b:=8;
               11,12:b:=10;
               else b:=bb;
               end;

      …

            end;
               end;
       end;
      end;
      {Отображение результата}
      case a of {Фактор А}
      1..5:begin
      FormTest.Memo1.Lines.Add(''Шизотермия'');
      …

      end;
      end;
      end;


      {добавление вопросов в Memo}
      procedure addtest;
      begin
      if nomer=1 then
          begin
            nomer:=nomer+1;
            clear;
             FormTest.memo1.Lines.Add('1.      Я  хорошо  понял  инструкцию,
которую только что прочитал:');
            FormTest.RadioGroup1.Items.Add('а) Да;');
            FormTest.RadioGroup1.Items.Add('в) не уверен;');
            FormTest.RadioGroup1.Items.Add('с) нет.');
           end
          else
            begin
              if nomer<188 then
                    if FormTest.RadioGroup1.ItemIndex=-1 then
                         messagedlg('Не  пропускайте   ничего,   обязательно
отвечайте на все вопросы подряд',mtinformation,[mbok],0)
                                                          else
                                                              begin
                                                               case  nomer-1
of

3..186:pballov;
                                                              end;

      clear;

      {Вопросы}
      case nomer of
       1:begin
             FormTest.memo1.Lines.Add('1.      Я  хорошо  понял  инструкцию,
которую только что прочитал:');
            FormTest.RadioGroup1.Items.Add('а) Да;');
            FormTest.RadioGroup1.Items.Add('в) не уверен;');
            FormTest.RadioGroup1.Items.Add('с) нет.');
         end;
       2:begin

      …

        188:begin
              whoru;
            end;

      end;
      if nomer<189 then nomer:=nomer+1;
      end;
      end;
      end;

      procedure TFormTest.buttonnextClick(Sender: TObject);
      begin
      if nomer=0 then
                 begin
                   nomer:=nomer+1;
                   memo1.ScrollBars:=ssNone;
                 end;
      if nomer=1 then
                  begin
                    RadioGroup1.Visible:=true;
                    label1.Visible:=false;
                    label3.Visible:=true;
                  end
              else
                 if nomer=188 then
                 begin
                    radiogroup1.Visible:=false;
                    memo1.ScrollBars:=ssVertical;
                    buttonnext.Caption:='Завершить';
                    buttonnext.Visible:=false;
                    BFinish.Visible:=true;
                    Label1.Visible:=false;
                    Label3.Visible:=false;
                 end;
      addtest;

      {if n>0 then
          begin
            case n of
              3:pballov;
            end;
          end;}
      end;

      procedure TFormTest.FormCreate(Sender: TObject);
      begin
      nomer:=0;
      end;

      procedure TFormTest.buttonPreviosClick(Sender: TObject);
      begin
      nomer:=nomer-1;
      addtest;
      end;

      procedure    TFormTest.FormClose(Sender:    TObject;    var    Action:
TCloseAction);
      begin
      Formmain.Edit1.Clear;
      Formmain.Edit2.Clear;
      Formmain.ComboSex.ItemIndex:=-1;
      Formmain.ComboAge.ItemIndex:=-1;
      formmain.Show;
      end;

      procedure  TFormTest.FormCloseQuery(Sender:  TObject;  var   CanClose:
Boolean);
      begin
      if nomer<188 then
      if messagedlg('Прекратить тестирование?',mtcustom,[mbyes,mbno],0)=mrno
then
      canclose:=false;
      end;

      procedure TFormTest.BFinishClick(Sender: TObject);
      begin
      close;
      end;

      procedure TFormTest.FormHide(Sender: TObject);
      begin
      memo1.Lines.LoadFromFile('memo\main.txt');
      RadioGroup1.Visible:=false;
      end;

      end.


ref.by 2006—2022
contextus@mail.ru