Program task3;
var 
	a,b,c:byte;
begin
	write('N=');
	readln(c);
		for a:=0 to c do
			for b:=0 to c do
				if 3*a+5*b = c then
				begin
					if a <> 0 then Write(a,' Troek, ');
					if b <> 0 then Write(b,' Pyaterok, ');
					Writeln(' = ',c)
				end;
end.

program test_variant_14;
uses crt, windos;
type
       rec=record
       vopros:string;
	 tip:byte;
       otvet:array [1..4] of string[100];
       ball:integer;
       end;

       st=record
       	fam:string;
        gruppa:integer;
       	ocenka:byte;
       end;

       
var
	zadanija:file of rec;
	students:file of st;
	stud:st;
	z:rec;
	pass:string;
	key:char;
	k:byte;
     
procedure menu_pr; forward;
procedure regim2; forward;
procedure test; forward;
procedure password; forward;



procedure menu;
begin
	repeat
      clrscr;
      writeln('programma testirovanie studentov ');
      writeln('  1. Prepod');
      writeln('  2. Student');
      writeln('  3. Vyhod');
	key:=readkey;
	until (ord(key)>=49) and (ord(key)<=51);
      case key of
      '1': password;
      '2': regim2;
      '3': halt(1);
      end;
end;


procedure prosmotr;
var
a,size:longint;
temp:file of rec;
i:byte;

begin
     assign(zadanija,'zadanija');
     {$I-}
     reset(zadanija);
     close(zadanija);
     {$I+}
     if IOResult <>0 then menu_pr;
     reset(zadanija);
     begin
	   while not eof(zadanija) do
	   begin
	    read(zadanija,z);
          clrscr;
          writeln('1-udalenie voprosa, 2-redaktirovanie');
          writeln('najmi lubuju klavishu dla sledujushego voprosa');
          writeln(z.vopros);
          writeln('Pravilnii otvet: ',z.otvet[1]);
          if z.tip<>2 then
	    for i:=2 to 4 do writeln('otvet № ',i,' ',z.otvet[i]);
          writeln('ball: ',z.ball);
          key:=readkey;
          if key='1' then
          begin
             A:=filepos(zadanija);
	Assign(temp,'temp');
	Rewrite(temp);
	Seek(zadanija,0);
	If (a-1)<>0 then
	While size<>(a-1) do
	Begin
		Read(zadanija,z);
		Write(temp,z);
		Size:=filepos(zadanija);
	end;
	seek(zadanija,a);
	while not eof(zadanija) do
	begin
		read(zadanija,z);
		write(temp,z);
	end;
	close(zadanija);
	close(temp);
	erase(zadanija);
	rename(temp,'zadanija');
	reset(zadanija);
	seek(zadanija,a-1);
	   end;
        if key='2' then
        begin
          seek(zadanija,filepos(zadanija)-1);
         writeln('vvedi vopros:');
      readln(z.vopros);
      writeln('  Vyberete tip voprosa;');
      writeln('  1- neskolko variantov otveta ');
      writeln('  2- trebuetsya vvod znacheniya');
	repeat
      key:=readkey;
	until (key='1') or (key='2');
      case key of
      '1':z.tip:=1;
      '2':z.tip:=2;
      end;
      writeln('  Vvedi pravilnyi otvet');
      Readln(z.otvet[1]);
      If z.tip=1 then
	for i:=2 to 4 do
                     begin
                       z.otvet[i]:='';
                       writeln('  Vvedi otvet №',i);
                       readln(z.otvet[i]);
			   end;
	writeln('  Vvedi bally za pravilnyi otvet');
	repeat
	{$I-}
      readln(z.ball);
	{$I+}
	Until Ioresult=0;
	{$I-}
        write(zadanija,z);
        seek(zadanija,filepos(zadanija)-1);
        end;
     end;
     clrscr;
     writeln('вы просмотрели все задания');
     writeln('нажмите любую клавишу,');
     writeln('чтобы выйти в предыдущее меню');
     key:=readkey;
     menu_pr;
end;
end;

procedure otchet;
var
temp:file of rec;
begin
	assign(students,'students');
	{$I-}
	Reset(students);
	close(students);
	{$I+}
	if IOResult <> 0 then
	      begin

               writeln('ERROR!!! Nikto ne proshel test!');
	       writeln('Najmi lyubuyu klavishu');
      	       key:=readkey;
               menu_pr;
	      end;
   	reset(students);
	while not eof(students)do
	begin
	read(students,stud);
	clrscr;
      writeln(' Familiya: ',stud.fam);
      writeln(' Gruppa: ',stud.gruppa);
      writeln(' ball: ',stud.ocenka);
	writeln;
	writeln(' Najmite lyubuyu klavishu,chtoby prosmotret otchet dalshe');
	key:=readkey;
	end;
	clrscr;
	writeln(' Najmite lyubuyu klavishu,chtoby vyiti v menyu');
	key:=readkey;
	menu_pr;
end;

procedure vvod;{ввод новых заданий}
var
i,j:byte;
begin
      Assign(zadanija,'zadanija');
      clrscr;
      writeln('vvedi vopros:');
      readln(z.vopros);
      writeln('  Vyberete tip voprosa;');
      writeln('  1- neskolko variantov otveta ');
      writeln('  2- trebuetsya vvod znacheniya');
	repeat
      key:=readkey;
	until (key='1') or (key='2');
      case key of
      '1':z.tip:=1;
      '2':z.tip:=2;
      end;
      writeln('  Vvedi pravilnyi otvet');
      Readln(z.otvet[1]);
      If z.tip=1 then
	for i:=2 to 4 do
                     begin
                       z.otvet[i]:='';
                       writeln('  Vvedi otvet №',i);
                       readln(z.otvet[i]);
			   end;
	writeln('  Vvedi bally za pravilnyi otvet');
	repeat
	{$I-}
      readln(z.ball);
	{$I+}
	Until Ioresult=0;
	{$I-}
      reset(zadanija);
	{$I+}
	If ioresult<>0 then
	Begin
		rewrite(zadanija);
                close(zadanija);
	End;
      reset(zadanija);
      seek(zadanija,filesize(zadanija));
      write(zadanija,z);
      close(zadanija);
      writeln('  Novoe zadanie dobavleno');
      writeln('  Najmi lyubuyu klavishu');
      key:=readkey;
      menu_pr;
end;

procedure password;
begin
	clrscr;
	repeat
	writeln('  vvedi parol (123) Dlya vyhoda vvedi EXIT');
	readln(pass);
	if pass = 'EXIT' then menu;
	write(' ERROR!! Parol nevernyi ');
	until pass='123';
	menu_pr;
end;
procedure menu_pr;
begin
	repeat
        clrscr;
      writeln(' 1. Vvod novyh zadanii');
      writeln(' 2. Prosmotr i udalenie zadanii');
      writeln(' 3. Otchet ');
      writeln(' 4. Vyhod');
      key:=readkey;
	until (key>='1') and (key<='4');
      case key of
       '1': vvod;
       '2': prosmotr;
       '3': otchet;
       '4': menu;
      end;
end;




procedure regim2;
begin
CLRSCR;
       assign(zadanija,'zadanija');
        {$I-}
	reset(zadanija);
        close(zadanija);
	{$I+}
	if IOResult <> 0 then
	            begin
                         writeln('ERROR!!');
	                 writeln('Vvedi zadaniya dlya testa');
	                 writeln;
	                 writeln('Najmi lyubuyu knopku');
	                 key:=readkey;
      	                 menu;
                    end;
      writeln('Vvedi familiyu:');
      readln(stud.fam);
      writeln('vvedi nomer gruppy');
	repeat
	{$I-}
      readln(stud.gruppa);
	{$I+}
	Until (Ioresult=0) and (stud.gruppa>=1000) and (stud.gruppa<=9999);
      writeln('Vy zaregistrirovalis');
      writeln('najmite lyubuyu klavishu dlya nachala testa');
      key:=readkey;
      test;

end;


procedure test;

var
	otvet,vop:byte;
	m: array [1..4] of byte;
        n,k1,stball:byte;
	Hour,min,sec,sec100,time:word;
        time_hour,time_min,time_sec:word;
	Otvet1:string;
Label 1;
begin
        vop:=0;
        stball:=0;
	Assign(zadanija,'zadanija');
	reset(zadanija);
	gettime(Hour,min,sec,sec100);
	time_sec:=filesize(zadanija)*15+sec;
        time:=filesize(zadanija)*15;
        time_min:=min;
        time_hour:=hour;
	if time_sec>=60 then
	begin
	inc(min);
	time_min:=min;
	time_sec:=time_sec-60;
	if time_min>=60 then
	begin
	inc(hour);
	time_hour:=hour;
	time_min:=time_min-60;
        end;
        end;
	repeat
      	read(zadanija,z);
 		clrscr;
        writeln('na kajdoe zadanie otvedeno 15sek');
        writeln('poetomu vsego u vas ',time,' sek');
      	writeln(z.vopros);

      	if z.tip=1 then
		begin
      	randomize;
      	writeln;
      	writeln('otvety:');
      	for n:=1 to 4 do
      	begin
1:    	m[n]:=random(5);
      	for k1:=1 to (n-1) do
      	if m[n]=m[k1] then goto 1;
      	if m[n]=0 then goto 1;
      	if m[n]=1 then otvet:=n;
      	writeln(z.otvet[m[n]]);
      	end;
      	writeln('Vvedi № pravilnogo otveta');
      	writeln('Najmi Esc dlya vyhoda iz testa');
		repeat
        key:=readkey;
        until ((key>='1') and (key<='5') or (key=#27));
      	case key of
      	 '1'..'5':begin
        Str(otvet,otvet1);
        If key=otvet1 then
        begin
        stball:=stball+z.ball;
        inc(vop);
        end;
                      end;
      	 #27:menu;
      	end;
		end;
		if z.tip=2 then
		begin
        writeln('Vvedi otvet ');
      	writeln('Vvedi EXIT dlya vyhoda iz testa');
      	readln(otvet1);
      	if otvet1=z.otvet[1] then
                           begin
                            stball:=stball+z.ball;
                            inc(vop);
                           end;
      	if otvet1='EXIT' then menu;
		end;
		gettime(hour,min,sec,sec100);
	until (hour*10000+min*100+sec>=time_hour*10000+time_min*100+time_sec) or (eof(zadanija));
        clrscr;
        if (hour*10000+min*100+sec>=time_hour*10000+time_min*100+time_sec) and (not eof(zadanija)) then
        writeln('vremja isteklo')
        else  writeln('vy proshli test!');
      writeln('Vy nabrali ', stball,' ballov');
      writeln('pravilnyh otvetov: ',vop);
      stud.ocenka:=stball;
      assign(students,'students');
      {$I-}
      Reset(students);
      {$I+}
      if IOResult <> 0 then
        begin
	 rewrite(students);
         close(students);
        end;
        reset(students);
        seek(students,filesize(students));
        write(students,stud);
        close(students);
	writeln('najmi lyubuyu klavishu');
	key:=readkey;
	menu;
end;

begin
menu
end.

unit unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var st,st_p:string;
          i:integer;
begin
  st:=Edit1.text;
  i:=1;
  st_p:=st;
  for i:=1 to Length(St_p) do
   if (st_p[i]='0') and (st_p[i+1]='0') then
    st_p[i+1]:='1';
  memo1.Lines.Add('введено   :  '+st);
  memo1.lines.Add('получаем :  '+st_p);
  Edit1.Text:=''
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 edit1.Text:='';
 Memo1.Text:='Вводится Последовательность Из 0 И 1. Программа Должна Выдать 0 Если Число 0-Ей Больше И 1 – В Противном Случае.';
 end;

end.

procedure TForm1.Button1Click(Sender: TObject);
var 
 x,y:integer;
 st:string;
begin
 st:=Edit1.text;
 y:=0;
 for x:=1 to length(st) do
   if st[x]='0' then inc(y);
 if y>(length(st) div 2) then y:=0 else y:=1;
 memo1.Lines.Add('введено   :  '+st);
 memo1.lines.Add('получаем :  '+intostr(y));
 Edit1.Text:=''
end;

function Trace(txt:string):string;
Begin
  form1.Memo1.Lines.Add(txt);
End;


procedure TForm1.Button1Click(Sender: TObject);
var
  i           : integer;
  st_0, st_1  : integer;
  TxtLine     : string;
begin
  st_0 := 0;
  st_1 := 0;
  Memo1.Text := '';
  Trace('Исходная строка: '+Edit1.Text);
  TxtLine := Edit1.Text;
  For i := 1 to Length(Edit1.Text) Do
    Begin
      If StrToInt(TxtLine[i]) = 0 then st_0 := st_0 + 1;//inc(st_0)
      If StrToInt(TxtLine[i]) = 1 then st_1 := st_1 + 1;
      if (StrToInt(TxtLine[i]) <> 1) and (StrToInt(TxtLine[i]) <> 0) then
        Begin
          ShowMessage('Введено другое число, пожалуйста введите правильно!');
          Edit1.Text := '';
          Memo1.Text := '';
          Exit;
        End;
    End;
  If st_0 = st_1 then Trace('Нулей и единиц поровну [ 0 = 1]')
    Else
      If st_0 > st_1 then Trace('Нулей больше чем единиц [0 > 1] : 0')
        Else
          Trace('Нулей меньше, чем единиц [0 < 1] : 1');

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  edit1.Text:='';
  Memo1.Text:='';
end;

end.