3. Текст модуля unit2.Pas

unit Unit2;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls;

type

TOKBottomDlg = class(TForm)

Bevel1: TBevel;

StaticText1: TStaticText;

StaticText2: TStaticText;

Bevel2: TBevel;

StaticText3: TStaticText;

StaticText4: TStaticText;

BitBtn1: TBitBtn;

StaticText5: TStaticText;

private

{ Private declarations }

public

{ Public declarations }

end;

var

OKBottomDlg: TOKBottomDlg;

implementation

{$R *.DFM}

end.

4. Текст модуля unit3.Pas

unit Unit3;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls;

type

TOKRightDlg = class(TForm)

Bevel1: TBevel;

StaticText1: TStaticText;

StaticText2: TStaticText;

StaticText3: TStaticText;

StaticText4: TStaticText;

StaticText5: TStaticText;

BitBtn1: TBitBtn;

Image1: TImage;

private { Private declarations }

public { Public declarations }

end;

var

OKRightDlg: TOKRightDlg;

implementation

{$R *.DFM}

end.

5. Текст модуля Unit3.Pas

unit Unit4;

interface

uses

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

StdCtrls, ExtCtrls, ComCtrls;

type

TForm4 = class(TForm)

Bevel1: TBevel;

ComboBox1: TComboBox;

Label1: TLabel;

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

Label2: TLabel;

UpDown1: TUpDown;

procedure Button2Click(Sender: TObject);

procedure ComboBox1Change(Sender: TObject);

procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);

procedure Button1Click(Sender: TObject);

procedure Button1KeyPress(Sender: TObject; var Key: Char);

procedure Button2KeyPress(Sender: TObject; var Key: Char);

procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);

procedure FormShow(Sender: TObject);

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

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form4 : TForm4;

gd,gt : TeXtFile;

implementation

uses unit1;

{$R *.DFM}

procedure TForm4.ComboBox1Change(Sender: TObject);

begin

if ComboBox1.Text=ComboBox1.Items[1] then

begin

Label2.Caption:='Укажите список вопросов, 1-'+inttostr(n);

Edit1.Enabled:=True;

Edit1.Clear;

if n>=3 then Edit1.Text:='1-2,3 '+IntToStr(n)

else Edit1.Text:='1';

Updown1.Visible:=false;

end

else

if ComboBox1.Text=ComboBox1.Items[0] then

begin

Label2.Caption:='Задайте кол-во вопросов, max='+inttostr(n);

Edit1.Clear;

Edit1.Enabled:=False;

Edit1.Text:=inttostr(updown1.Position);

Updown1.Visible:=True;

Updown1.Position:=n div 2;

end

end;

procedure TForm4.ComboBox1KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13 then

begin

if ComboBox1.Text=ComboBox1.Items[1] then

begin

Label2.Caption:='';

Edit1.SetFocus;

end;

end;

end;

procedure TForm4.Button1Click(Sender: TObject);

var ss : set of byte;

cn,v,k1,k2 : longint;

fn,sf : string;

fnd : char;

procedure NewFile4Ticket(q:longint);

begin

if q>0 then

begin

v:=0;

fnd:='a';

while (v=0)and(fnd<>succ('z')) do

begin

sf:='QUES_'+fnd+'.txt';

AssignFile(gd,sf);

Try

reset(gd);

Except

v:=1;

AssignFile(gt,'ANS_'+fnd+'.txt');

rewrite(gt);

rewrite(gd);

if q>0 then writeln(gd,q);

end;

fnd:=succ(fnd);

end;

if fnd=succ('z') then

begin

MessageDlg

('В текущем каталоге больше нельзя создавать файлы вопросов'

,mtWarning,[mbOK],0);

sf:='';

end

end

else

MessageDlg('Создаваемый билет не содержит вопросов'

,mtWarning,[mbOK],0);

end;

procedure CopySet2file;

var b1,b2,vv,m:longint;

begin

b1:=1;

//for vv := 1 to n do

while ss<>[] do

begin

vv:=1+random(n);

if vv in ss then

begin

exclude(ss,vv);

reset(tt);

for m:=1 to vv do readln(tt,b2,fn);

writeln(gt,b1,fn);

inc(b1);

reset(fd);

readln(fd,fn);

while vv>1 do

begin

repeat

readln(fd,fn);

until fn='';

dec(vv);

end;

repeat

readln(fd,fn);

writeln(gd,fn)

until fn='';

end

else

begin

readln(tt,fn);

repeat

readln(fd,fn);

until fn=''

end;

end;

CloseFile(gd);

CloseFile(gt);

end;

begin

if ComboBox1.Text=ComboBox1.Items[0] then

begin

NewFile4Ticket(Updown1.Position);

if sf<>'' then

begin

cn:=Updown1.Position;

ss:=[];

while cn>0 do

begin

v := 1+random(n);

if not (v in ss) then

begin

include(ss,v);

dec(cn);

end;

end;

CopySet2file;

MessageDlg('Создан экзаменационный билет '+sf

,mtInformation,[mbOK],0);

end;

end

else

begin

if ComboBox1.Text=ComboBox1.Items[1] then

begin

fn:=Edit1.Text;

{проверка на наличие цифр в строке и убирание левых симв-в}

cn:=0;

for v:=1 to length(fn) do

begin

if fn[v] in ['0'..'9'] then cn:=1;

if not(fn[v] in ['0'..'9',' ',',','-']) then fn[v]:=' ';

end;

if cn=0 then

begin

MessageDlg('Такая строка не может быть воспринята и обработана'

,mtWarning,[mbOK],0);

Edit1.Setfocus;

Exit;

end;

{Убираем лажу до первой и после последней цифры}

v:=1;

while not(fn[v] in ['0'..'9']) do

begin

fn[v]:=' ';

inc(v);

end;

v:=length(fn);

while not(fn[v] in ['0'..'9']) do

begin

fn[v]:=' ';

dec(v);

end;

{Синтаксическая проверка на ',' & '-' & исправление ошибок}

cn:=0;

for v := 1 to length(fn) do

begin

{ ','|'-' не могут идти друг за другом без цифры}

if (fn[v] in [',','-']) then

begin

if(cn=1) then fn[v]:=' ';

cn:=1;

end;

if (fn[v] in ['0'..'9']) then cn:=0;

end;

{Убрать двойные пробелы}

v:=1;

while v<=length(fn) do

begin

if (v<length(fn))and(copy(fn,v,2)=' ') then

delete(fn,v,1)

else inc(v);

end;

if fn[1]=' ' then delete(fn,1,1);

{вставить пробелы 'X-Y'}

v:=2;

while v<length(fn) do

begin

if (fn[v-1] in ['0'..'9'])and(fn[v]='-') then

begin

insert(' ',fn,v);

inc(v);

end;

if (fn[v]='-')and(fn[v+1] in ['0'..'9']) then

begin

insert(' ',fn,v+1);

end;

inc(v);

end;

{получение множества из строки}

ss:=[];

v:=1;

fn:=fn+' ';

while v<=length(fn)do

begin

if fn[v] in ['0'..'9'] then

begin

fnd:='0';

k1:=0;

while not(fnd in [' ',',']) do

begin

k1:=k1*10+(ord(fnd) xor $30);

fnd:=fn[v];

inc(v);

end;

include(ss,k1);

dec(v);

end;

if fn[v]='-' then

begin

inc(v,2);

fnd:='0';

k2:=0;

while (fnd<>' ')and(fnd<>',') do

begin

k2:=k2*10+(ord(fnd) xor $30);

fnd:=fn[v];

inc(v);

end;

if k2<k1 then

begin

asm

mov eax,k2

xchg eax,k1

mov k2,eax

end;

end;

for cn:=k1 to k2 do include(ss,cn);

k1:=k2;

dec(v);

end;

inc(v);

end;

cn:=0;

for v:=1 to n do if v in ss then inc(cn);

NewFile4Ticket(cn);

if cn>0 then

begin

CopySet2file;

MessageDlg('Создан экзаменационный билет '+sf

,mtInformation,[mbOK],0);

end

else

begin

Edit1.Setfocus;

Exit;

end;

end;

end;

Button2Click(Sender);

end;

procedure TForm4.Button2Click(Sender: TObject);

begin

Form4.Close;

end;

procedure TForm4.Button1KeyPress(Sender: TObject; var Key: Char);

begin

Button1Click(Sender);

end;

procedure TForm4.Button2KeyPress(Sender: TObject; var Key: Char);

begin

Form4.Close;

end;

procedure TForm4.UpDown1Click(Sender: TObject; Button: TUDBtnType);

begin

Edit1.Text:=inttostr(updown1.Position);

end;

procedure TForm4.FormShow(Sender: TObject);

begin

Updown1.Min:=1;

Updown1.Max:=n;

Updown1.Position:=n div 2;

ComboBox1Change(Sender);

end;

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

begin

Edit1.Clear;

Edit1.Enabled:=False;

Label2.Caption:='';

Updown1.Visible:=False;

end;

end.

end.