Реферат: Разработка программы психотестирования

   rb1.Enabled:=false;

   rb2.Enabled:=false;

   rb3.Enabled:=false;

   inc(testcount,test[defque].count[3])

end;

procedure TfrmTest.SpeedButton1Click(Sender: TObject);

var f:file of TResult;

r:tresult;

begin

   inc(defque);

   if defque=testnum then begin

      assignfile(f,copy(testfilename,1,length(testfilename)-3)+'rts');

      reset(f);

      while not eof(f) do begin

        read(f,r);

        if testcount in [r.min..r.max] then begin

           frmres.label1.Caption:=r.text;

           break

        end

      end;

      closefile(f);

      frmtest.hide;

      frmres.show;

   end;

   load

end;

procedure TfrmTest.FormClose(Sender: TObject; var Action: TCloseAction);

begin

   frmmain.show;

   action:=cahide

end;

end.

unit Resfrm;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls;

type

  TfrmRes = class(TForm)

    Label1: TLabel;

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  frmRes: TfrmRes;

implementation

uses Mainfrm;

{$R *.DFM}

procedure TfrmRes.Button1Click(Sender: TObject);

begin

   frmres.hide;

   frmmain.show

end;

procedure TfrmRes.FormClose(Sender: TObject; var Action: TCloseAction);

begin

   action:=cahide;

   frmmain.show

end;

end.

unit TestTypes;

interface

 type

  TTest=record

     text:string[255];

     quest:array[1..3] of string[100];

     count:array[1..3] of byte;

  end;

 var

    testfilename: string;

    test:array[1..100] of ttest;

    testnum:byte;

implementation

end.

 

Листинг программы ТС:

unit Mainfrm;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, Spin, TestTypes;

type

  TfrmMain = class(TForm)

    rb1: TRadioButton;

    rb2: TRadioButton;

    rb3: TRadioButton;

    Edit1: TEdit;

    Label1: TLabel;

    SpinEdit1: TSpinEdit;

    Label2: TLabel;

    Edit2: TEdit;

    Label3: TLabel;

    Label4: TLabel;

    Button1: TButton;

    Button2: TButton;

    SaveDialog1: TSaveDialog;

    OpenDialog1: TOpenDialog;

    StaticText1: TStaticText;

    Label5: TLabel;

    SpinEdit2: TSpinEdit;

    Button3: TButton;

    procedure Button2Click(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure Edit1Change(Sender: TObject);

    procedure Edit2Change(Sender: TObject);

    procedure rb1Click(Sender: TObject);

    procedure rb2Click(Sender: TObject);

    procedure rb3Click(Sender: TObject);

    procedure SpinEdit1Change(Sender: TObject);

    procedure SpinEdit2Change(Sender: TObject);

    procedure Button3Click(Sender: TObject);

  private

    { Private declarations }

  public

     variant:^tradiobutton;

     nq:byte;

  end;

var

  frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.Button2Click(Sender: TObject);

var f:file of TTest;

i:byte;

begin

     if savedialog1.execute then begin

        assignfile(f,savedialog1.Filename);

        rewrite(f);

        for i:=1 to testnum do write(f,test[i]);

        closefile(f)

     end

end;

procedure TfrmMain.Button1Click(Sender: TObject);

var f:file of ttest;

begin

     if opendialog1.execute then begin

        assignfile(f,opendialog1.Filename);

        reset(f);

        testnum:=1;

        while not eof(f) do begin

           read(f,test[testnum]);

           inc(testnum)

        end;

        statictext1.Caption:='Всего вопросов '+inttostr(testnum);

        closefile(f);

        spinedit1.value:=1;

        spinedit1change(sender)

     end

end;

procedure TfrmMain.FormCreate(Sender: TObject);

var i:byte;

begin

     testnum:=1;

     variant:=@rb1;

     nq:=1;

     for i:=1 to 100 do begin

         test[i].quest[1]:='Вариант1';

         test[i].quest[2]:='Вариант2';

         test[i].quest[3]:='Вариант3';

         test[i].count[1]:=0;

         test[i].count[2]:=0;

         test[i].count[3]:=0;

         test[i].text:='Текст вопроса'

     end;

end;

procedure TfrmMain.Edit1Change(Sender: TObject);

begin

     label2.Caption:=edit1.Text;

     test[spinedit1.value].text:=edit1.text

end;

procedure TfrmMain.Edit2Change(Sender: TObject);

begin

     variant^.Caption:=edit2.Text;

     test[spinedit1.value].quest[nq]:=edit2.text

end;

procedure TfrmMain.rb1Click(Sender: TObject);

begin

     variant:=@rb1;

     nq:=1;

     edit2.Text:=rb1.Caption;

     spinedit2.Value:=test[spinedit1.Value].count[1];

     edit2.SetFocus

end;

procedure TfrmMain.rb2Click(Sender: TObject);

begin

     variant:=@rb2;

     nq:=2;

     edit2.Text:=rb2.Caption;

     spinedit2.Value:=test[spinedit1.Value].count[2];

     edit2.SetFocus

end;

procedure TfrmMain.rb3Click(Sender: TObject);

begin

     variant:=@rb3;

     nq:=3;

     edit2.Text:=rb3.Caption;

     spinedit2.Value:=test[spinedit1.Value].count[3];    

     edit2.SetFocus

end;

procedure TfrmMain.SpinEdit1Change(Sender: TObject);

begin

     if spinedit1.value>testnum then begin

        inc(testnum);

        statictext1.caption:='Всего вопросов '+inttostr(testnum)

     end;

     label2.Caption:=test[spinedit1.value].text;

     rb1.Caption:=test[spinedit1.value].quest[1];

     rb2.Caption:=test[spinedit1.value].quest[2];

     rb3.Caption:=test[spinedit1.value].quest[3];

     rb1.Checked:=true;

     variant:=@rb1;

     edit1.Text:=test[spinedit1.value].text;

     edit2.text:=test[spinedit1.value].quest[1];

     edit2.setfocus

end;

procedure TfrmMain.SpinEdit2Change(Sender: TObject);

begin

     test[spinedit1.value].count[nq]:=spinedit2.value

end;

procedure TfrmMain.Button3Click(Sender: TObject);

var i:byte;

begin

   if spinedit1.value=testnum then begin

      dec(testnum);

      spinedit1.value:=spinedit1.value-1;

      exit

   end;

   if testnum=1 then exit;

   for i:=spinedit1.value to testnum-1 do test[i]:=test[i+1];

   dec(testnum);

   spinedit1change(sender);

   statictext1.Caption:='Всего вопросов '+inttostr(testnum)

end;

end.

Листинг программы RС:

unit Mainfrm;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  testtypes, StdCtrls, Spin;

type

  TfrmMain = class(TForm)

    Memo1: TMemo;

    SpinEdit1: TSpinEdit;

    Label1: TLabel;

    SpinEdit2: TSpinEdit;

    Label2: TLabel;

    Button1: TButton;

    Button2: TButton;

    SpinEdit3: TSpinEdit;

    Label3: TLabel;

    OpenDialog1: TOpenDialog;

    SaveDialog1: TSaveDialog;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure SpinEdit1Change(Sender: TObject);

    procedure SpinEdit2Change(Sender: TObject);

    procedure Memo1Change(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure SpinEdit3Change(Sender: TObject);

  private

    { Private declarations }

  public

   res:array[1..100] of tresult;

   varnum:byte;

   no:boolean;

  end;

var

  frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.Button1Click(Sender: TObject);

var f:file of tresult;

i:byte;

begin

   if savedialog1.execute then begin

      assignfile(f,savedialog1.filename);

      rewrite(f);

      for i:=1 to varnum-1 do write(f,res[i]);

      closefile(f)

   end

end;

procedure TfrmMain.Button2Click(Sender: TObject);

var f:file of tresult;

begin

   if opendialog1.execute then begin

      assignfile(f,opendialog1.filename);

      reset(f);

      varnum:=1;

      while not eof(f) do begin

         read(f,res[varnum]);

         inc(varnum)

      end;

      memo1.text:=res[1].text;

      spinedit1.value:=res[1].min;

      spinedit2.value:=res[1].max;

      spinedit3.value:=1;

      closefile(f)

   end

end;

procedure TfrmMain.SpinEdit1Change(Sender: TObject);

begin

   if no then exit;

   res[spinedit3.value].min:=spinedit1.value;

   if spinedit2.value<spinedit1.value then spinedit2.value:=spinedit1.value

end;

procedure TfrmMain.SpinEdit2Change(Sender: TObject);

begin

   if no then exit;

   res[spinedit3.value].max:=spinedit2.value;

end;

procedure TfrmMain.Memo1Change(Sender: TObject);

var i:integer;

begin

   if not no then for i:=1 to length(memo1.text) do res[spinedit3.value].text[i]:=memo1.text[i]

end;

procedure TfrmMain.FormCreate(Sender: TObject);

begin

   varnum:=1;

   no:=false

end;

procedure TfrmMain.SpinEdit3Change(Sender: TObject);

begin

   no:=true;

   if varnum<spinedit3.value then varnum:=spinedit3.value;

   memo1.text:=res[spinedit3.value].text;

   spinedit1.value:=res[spinedit3.value].min;

   spinedit2.value:=res[spinedit3.value].max;

   no:=false;

   memo1.SetFocus

end;

end.