коментарии к коду - Помощь студентам

peredoz · 22.12.2012, 21:45

Код:

uses crt;
 type
 ps=^info;
 info=record
 rn:word;
 FIO:string;
 KL:string[20];
 DR:string[10];
 MR:string[20];
 rost:byte;
 CG:string[10];
 CV:string[10];
 PP:string[20];
 OP:string[50];
 MN:String[30];
 l,r:ps;
 end;
 var
 F,f1,fa:file of info;
 Buf,b2:info;
 t,top,s,n,k,pa,p:ps;
 gmenu,vmenu,i,zz,
 q,j,m,flag,nrn,nom,sch:integer;
 key,h,v:char;
 menu:array[0..16] of string;

ребят нужен Коментарии к этому коду, код не мой, основная часть кода ниже, заранее спасибо))

Код:

uses crt;
 type
 ps=^info;
 info=record
 rn:word;
 FIO:string;
 KL:string[20];
 DR:string[10];
 MR:string[20];
 rost:byte;
 CG:string[10];
 CV:string[10];
 PP:string[20];
 OP:string[50];
 MN:String[30];
 l,r:ps;
 end;
 var
 F,f1,fa:file of info;
 Buf,b2:info;
 t,top,s,n,k,pa,p:ps;
 gmenu,vmenu,i,zz,
 q,j,m,flag,nrn,nom,sch:integer;
 key,h,v:char;
 menu:array[0..16] of string;

 procedure ramka (xx,yy,g,w,c,cs,d,p:integer; cv,pr:string);
 var a,j,x,y:integer;
 Begin
 x:=xx+2; y:=yy+2;
 gotoxy(x,y); textcolor(15); write(PR);
 a:=length(cv);
 if cv='' then a:=0;
 textcolor(c);
 gotoxy(xx,yy);
 if d=1 then
 write('+') else write('+');
 for j:=1 to trunc((g/2)-(a/2)) do if d=1 then
 write('-') else write('-');
 textcolor(cs); write(cv);
 textcolor(c);
 for i:=1 to trunc((g/2)-(a/2)) do if d=1 then
 write('-') else write('-');
 if d=1 then
 write('+') else write('+');
 for i:=1 to w do begin
 gotoxy(xx,yy+i);
 textcolor(c);
 if d=1 then
 write('¦') else write('¦');
 gotoxy((g+xx+1),yy+i);
 if d=1 then
 write('¦') else write('¦');
 end;
 gotoxy(xx,w+yy);
 if d=1 then
 write('+') else write('+');
 for j:=1 to (trunc((g/2)-(a/2))*2+a) do if d=1 then
 write('-') else write('-');
 if d=1 then
 write('+') else write('+'); gotoxy(80,1);
 if p=1 then readln;
 end;
 procedure arxiv;
 begin
 clrscr;
{rewrite(fa);}
 ramka(3,1,73,14,12,14,1,0,' АРХИВ ','');
 gotoxy(10,3);textcolor(11);
 write('Введите регитсрационный номер "завязавшего" №= ');
 readln(nom);
 rewrite(f1); reset(fa); reset(f); flag:=0;
 if filesize(fa)<>0 then seek(fa,filesize(fa));
 repeat
 read(f,b2);
 if (b2.rn<>nom) then write(f1,b2)
 else begin
 write(fa,b2);
 Flag:=1;
 end;
 until eof(f);
 if flag=0 then
 begin
 sound (600);
 delay (2222);
 nosound;
 textbackground(4);
 ramka (26,7,32,4,14,9,1,1,' ОШИБКА', 'НЕВОЗМОЖНО ВЫПОЛНИТЬ ОПЕРАЦИЮ');
 textbackground(0);
 end
 else
 begin
 sound (3100);
 delay (2222);
 nosound;
 textbackground(1);
 ramka(28,8,32,4,14,9,1,1,' DELETE' , 'ПРЕСТУПНИК ПЕРЕМЕЩЁН В АРХИВ');
 textbackground(0);
 end;
 CLRSCR;
 close(f); close(f1); close(fa);
 if flag=1 then
 begin
 erase(f);
 assign(f,'interp1.dat');
 rename(f,'interp.dat');
 end;
 clrscr;
 end;
procedure main (x,y:integer; s:string; select:integer);
var
 colorbg:integer;
 begin
 gotoxy (x,y);
 if select=1 then colorbg:=7
 else colorbg:=15;
 if select=2 then colorbg:=11;
 if select=3 then colorbg:=7;
 if select=4 then colorbg:=1;
 textcolor (colorbg);
 textbackground (0);
 writeln (s);
 end;
 procedure podbor_kandidaturi(wer:integer);
 begin
 ramka(3,1,74,16,11,15,1,0,' ПОДБОР КАНДИДАТУРЫ ','');
 reset(f);
 if wer=1 then begin gotoxy(7,2); write('Введите ФИО - '); readln(b2.FIO); end;
 if wer=2 then begin gotoxy(7,2); write('Введите кличку - '); readln(b2.KL); end;
 if wer=3 then begin gotoxy(7,2); write('Введите дату рождения - '); readln(b2.DR); end;
 if wer=4 then begin gotoxy(7,2); write('Введите рост - '); readln(b2.rost); end;
 if wer=5 then begin gotoxy(7,2); write('Введите цвет волос - '); readln(b2.CV); end;
 textcolor(14);
 repeat
 read(f,buf);
 if ((b2.FIO=buf.FIO) or (b2.KL=buf.KL) or
 (b2.DR=buf.DR) or (b2.rost=buf.rost) or (b2.CV=buf.CV)) then
 begin
 gotoxy(7,3);
 writeln('Подходящая кандидатура'); gotoxy(5,5);
 write('Регистрационный номер - ',buf.rn); gotoxy(5,6);
 write('ФИО - ',buf.FIO); gotoxy(5,7);
 write('Кличка - ',buf.KL); gotoxy(5,8);
 write('Дата рождения - ',buf.DR); gotoxy(5,9);
 write('Место рождения - ',buf.MR); gotoxy(5,10);
 write('Рост - ',buf.rost); gotoxy(5,11);
 write('Цвет глаз - ',buf.CG); gotoxy(5,12);
 write('Цвет волос - ',buf.CV); gotoxy(5,13);
 write('Преступная профессия - ',buf.PP); gotoxy(5,14);
 write('Особые приметы - ',buf.OP); gotoxy(5,15);
 write('Место нахождение - ',buf.MN);
 end;
 until eof(f);
 readln;
 close(f);
 clrscr;
 END;
 procedure Spisok_Zav;
 begin
 reset(fa);
 ramka(3,1,73,16,9,15,1,0,' СПИСОК ЗАВЯЗАВШИХ ','');
 textcolor(14);
 repeat

peredoz · 22.12.2012, 21:46

Код:

 read(fa,buf);
 gotoxy(5,4);
 write('Регистрационный номер - ',buf.rn); gotoxy(5,5);
 write('ФИО - ',buf.FIO); gotoxy(5,6);
 write('Кличка - ',buf.KL); gotoxy(5,7);
 write('Дата рождения - ',buf.DR); gotoxy(5,8);
 write('Место рождения - ',buf.MR); gotoxy(5,9);
 write('Рост - ',buf.rost); gotoxy(5,10);
 write('Цвет глаз - ',buf.CG); gotoxy(5,11);
 write('Цвет волос - ',buf.CV); gotoxy(5,12);
 write('Преступная профессия - ',buf.PP); gotoxy(5,13);
 write('Особые приметы - ',buf.OP); gotoxy(5,14);
 write('Место нахождение - ',buf.MN);
 gotoxy(80,1);
 readln;
 until eof(fa);
 close(fa);
 clrscr;
 end;
 procedure REGISTRATION;
 begin
 { rewrite(f); }
 reset(f);
 repeat
 ramka(3,1,73,19,9,14,1,0,' РЕГИСТРАЦИЯ ','');
 textcolor(7);
 gotoxy(5,2);
 write(' Зарегистрировать нового преступника, Да-d; Нет-n / ');
 readln (h);
 textcolor(12);
 if filesize(f)<>0 then seek(f,filesize(f));
 if (h='d') or (h='D') then begin
 gotoxy(5,4);
 write('Введите регистрационный номер - '); readln(buf.rn); gotoxy(5,5);
 write('Введите ФИО - '); readln(buf.FIO); gotoxy(5,6);
 write('Введите кличку - '); readln(buf.KL); gotoxy(5,7);
 write('Введите дату рождения - '); readln(buf.DR); gotoxy(5,8);
 write('Введите место рождения - '); readln(buf.MR); gotoxy(5,9);
 write('Введите рост - '); readln(buf.rost); gotoxy(5,10);
 write('Введите цвет глаз - '); readln(buf.CG); gotoxy(5,11);
 write('Введите цвет волос - '); readln(buf.CV); gotoxy(5,12);
 write('Введите преступную профессию - '); readln(buf.PP); gotoxy(5,13);
 write('Введите особые приметы - '); readln(buf.OP); gotoxy(5,14);
 write('Введите место нахождения - '); readln(buf.MN);
 end;
 zz:=0;
 if (filesize(f)<>0) and ((h='d') or (h='D')) then
 begin
 reset(f);
 repeat
 read(f,b2);
 if (b2.rn=buf.rn) and (b2.FIO=buf.FIO) then zz:=1;
 until eof(f);
 if zz=1 then
 begin
 sound (600);
 delay (2222);
 nosound;
 textbackground(4);
 ramka (41,7,28,4,15,14,2,1, 'ОШИБКА', 'ПРЕСТУПНИК УЖЕ СУЩЕСТВУЕТ');
 textbackground(0);
 end else write(f,buf);
 end;
 until (h<>'d') or (h<>'D');
 clrscr;
 close(F);
end;
 procedure PROSMOTR;
 begin
 ramka(3,1,74,16,11,15,1,0,' ПРОСМОТР ','');
 reset(f);
 top:=nil;
 while not eof(f) do
 begin
 new(n);
 read(f,buf);
 n^.l:=nil;
 n^.r:=top;
 if t<>nil then t^.l:=n;
 n^.rn:=buf.rn; n^.FIO:=buf.FIO; n^.KL:=buf.KL;
 n^.DR:=buf.DR; n^.MR:=buf.MR; n^.rost:=buf.rost;
 n^.CG:=buf.CG; n^.CV:=buf.CV; n^.PP:=buf.PP;
 n^.OP:=buf.OP; n^.MN:=buf.MN;
 t:=top;
 top:=n;
 end;
 t:=top;
 p:=nil;
 while t<>nil do
 begin
 if p<>nil then
 begin
 if p^.rn>t^.rn then
 begin
 p^.r:=t^.r;
 pa:=t^.r;
 pa^.l:=p;
 t^.r:=top;
 t^.l:=nil;
 top^.l:=t;
 top:=t;
 end;
 end;
 p:=t;
 t:=t^.r;
 end;
 t:=top; flag:=0; sch:=6;
 while t<>nil do
 begin
 textcolor(14);
 if flag=0 then begin
 gotoxy(5,4);
 writeln(' Ф И О ',' Дата рождения ');
 writeln(' |---------------------------------|');
 end;
 gotoxy(10,sch);
 write(t^.FIO,' ',t^.DR); {gotoxy(5,6); }
 t:=t^.r; sch:=sch+1; flag:=1;
 end;
 readln;
 clrscr;
 END;
 procedure DELETE;
 begin
 clrscr;
 ramka(13,10,52,4,12,13,1,0,' Выбирите ','');
 gotoxy(15,11); textcolor(11);
 writeln('Если преступник "Завязал" нажмите клавишу:пробел ');
 gotoxy(15,12); textcolor(11);
 writeln('Если преступник "откинул капыта" нажмите :ENTER ');
 gotoxy(15,13); write('|=');
 readln(v);
 if ord(v)=32 then arxiv else
 begin
 clrscr;
 ramka(3,1,73,19,9,14,1,0,' УДАЛЕНИЕ ','');
 gotoxy(20,3); textcolor(12);
 write('Введите регистрационный номер преступника:'); {gotoxy(15,2); }
 readln(nrn);
 reset(f); rewrite(f1);flag:=0;
 repeat
 read(f,b2);
 if (b2.rn<>nrn) then write(f1,b2)
 else flag:=1;
 until eof(f);
 if flag=0 then
 begin
 sound (600);
 delay (2222);
 nosound;
 textbackground(4);
 ramka(28,7,24,4,15,14,1,1, 'ОШИБКА', 'ПРЕСТУПНИК ОТСУТСТВУЕТ');
 textbackground(0);
 end
 else
 begin
 sound (3100);
 delay (2222);
 nosound;
 textbackground(1);
 ramka(28,8,20,4,15,14,1,1, 'DELETE' , 'ПРЕСТУПНИК УДАЛЁН');
 textbackground(0);
 end;
 CLRSCR;
 close(f);
 erase(f);
 close(f1);
 assign(f,'interp1.dat');
 rename(f,'interp.dat');
 end;
 clrscr;
 end;
 procedure screen (c:integer);
 begin
 textbackground (c);
 clrscr;
 end;
 begin
 assign (f,'interp.dat');
 assign (f1,'interp1.dat');
 assign(fa,'arxiv_interpol.dat');
 screen (0);

peredoz · 22.12.2012, 21:46

Код:

 menu[0]:=' ';
 menu[1]:=' ПРЕСТУПНИКИ ';
 menu[2]:=' ПОИСК ';
 menu[3]:=' ПОДБОР КАНДИДАТУРЫ ';
 menu[4]:=' Регистрация ';
 menu[5]:=' Удалить ';
 menu[6]:=' Выход ';
 menu[7]:=' Вывод всей базы ';
 menu[8]:=' Архив ';
 menu[9]:= ' По ФИО ';
 menu[10]:=' По кличке ';
 menu[11]:=' По росту ';
 menu[12]:=' По дате рождения ';
 menu[13]:=' По цвету волос ';
 menu[14]:=' ';
 menu[15]:=' ';
 gmenu:=1;
 repeat
 gotoxy(1,1);
 textcolor(0);
textbackground(0); {textattr:=79;}
 ramka(3,1,74,1,9,14,1,0,' КАРТОТЕКА ИНТЕРПОЛА ','');
 repeat
 if gmenu=1 then begin
 main (7,2,menu[1],0);
 main (35,2,menu[2],1);
 main (54,2,menu[3],1);
 gotoxy(80,2);
 end;
 if gmenu=2 then begin
 main (7,2,menu[1],1);
 main (35,2,menu[2],0);
 main (54,2,menu[3],1);
 Gotoxy(80,2);
 end;
 if gmenu=3 then begin
 main (7,2,menu[1],1);
 main (35,2,menu[2],1);
 main (54,2,menu[3],0); gotoxy(80,2);
 end;
 key:=Readkey;
 case key of
 #77: begin
 gmenu:=gmenu+1;
 if gmenu>3 then gmenu:=1;
 end;
 #75: begin
 gmenu:=gmenu-1;
 if gmenu<1 then gmenu:=3;
 end;
 end;
 until key=#13;
 case gmenu of
 1 : begin
 vmenu:=1;
 repeat
 if vmenu=1 then
 begin
 main (8,3,menu[0],4);
 main (8,4,menu[4],2);
 main (8,5,menu[5],3);
 main (8,6,menu[6],3);
 main (8,7,menu[0],4);
 ramka (7,3,14,4,12,14,2,0,'','');
 gotoxy(80,2);
 end;
 if vmenu=2 then
 begin
 main (8,4,menu[4],3);
 main (8,5,menu[5],2);
 main (8,6,menu[6],3); gotoxy(80,2);
 end;
 if vmenu=3 then
 begin
 main (8,4,menu[4],3);
 main (8,5,menu[5],3);
 main (8,6,menu[6],2); gotoxy(80,2);
 end;
 key:=Readkey;
 case key of
 #80 :begin vmenu:=vmenu+1;
 if vmenu>3 then vmenu:=1;
 end;
 #72 :begin vmenu:=vmenu-1;
 if vmenu<1 then vmenu:=3;
 end;
 #27:begin screen(0);vmenu:=-1;
 end;
 #13:begin screen(0);
 end;
 end;
 until (key=#13) or (key=#27);
 end;
 2: begin
 vmenu:=1;
 repeat
 if vmenu=1 then begin
 main (35,3,menu[14],4);
 main (35,4,menu[7],2);
 main (35,5,menu[8],3);
 main (35,6,menu[14],4);
 ramka (34,3,22,3,12,14,2,0,'','');
 gotoxy(80,2);
 end;
 if vmenu=2 then
 begin
 main (35,4,menu[7],3);
 main (35,5,menu[8],2); gotoxy(80,2);
 end;
 key:=Readkey;
 case key of
 #80 :begin vmenu:=vmenu+1;
 if vmenu>2 then vmenu:=1;
 end;
 #72 :begin vmenu:=vmenu-1;
 if vmenu<1 then vmenu:=2;
 end;
 #27 :begin screen(0); vmenu:=-1;
 end;
 #13:begin screen(0);
 end;
 end;
 until (key=#13) or (key=#27);
 end;
 3: begin
 vmenu:=1;
 repeat
 if vmenu=1 then begin
 main (55,3,menu[15],4);
 main (55,4,menu[9],2);
 main (55,5,menu[10],3);
 main (55,6,menu[11],3);
 main (55,7,menu[12],3);
 main (55,8,menu[13],3);
 main (55,9,menu[15],4);
 ramka (54,3,20,6,12,14,2,0,'','');
 gotoxy(80,2);
 end;
 if vmenu=2 then begin
 main (55,4,menu[9],3);
 main (55,5,menu[10],2);
 main (55,6,menu[11],3);
 main (55,7,menu[12],3);
 main (55,8,menu[13],3); gotoxy(80,2);
 end;
 if vmenu=3 then begin
 main (55,4,menu[9],3);
 main (55,5,menu[10],3);
 main (55,6,menu[11],2);
 main (55,7,menu[12],3);
 main (55,8,menu[13],3); gotoxy(80,2);
 end;
 if vmenu=4 then begin
 main (55,4,menu[9],3);
 main (55,5,menu[10],3);
 main (55,6,menu[11],3);
 main (55,7,menu[12],2);
 main (55,8,menu[13],3); gotoxy(80,2);
 end;
 if vmenu=5 then begin
 main (55,4,menu[9], 3);
 main (55,5,menu[10],3);
 main (55,6,menu[11],3);
 main (55,7,menu[12],3);
 main (55,8,menu[13],2); gotoxy(80,2);
 end;
 key:=Readkey;
 case key of
 #80 :begin vmenu:=vmenu+1;
 if vmenu>5 then vmenu:=1;
 end;
 #72 :begin vmenu:=vmenu-1;
 if vmenu<1 then vmenu:=5;
 end;
 #27 :begin screen(0); vmenu:=-1;
 end;
 #13:begin screen(0);
 end; end;
 until (key=#13) or (key=#27);
 end; end;
 case gmenu of
 1: case vmenu of
 1: begin REGISTRATION; vmenu:=-1;
 end;
 2: begin DELETE; vmenu:=-1;
 end;
 3:vmenu:=1;
 end;
 2: case vmenu of
 1: begin PROSMOTR; vmenu:=-1;
 end;
 2: begin Spisok_Zav; vmenu:=-1;
 end;
 end;
3: case vmenu of
 1:begin podbor_kandidaturi(1);
 vmenu:=-1;
 end;
 2:begin podbor_kandidaturi(2);
 vmenu:=-1;
 end;
 3:begin podbor_kandidaturi(3);
 vmenu:=-1;
 end;
 4:begin podbor_kandidaturi(4);
 vmenu:=-1;
 end;
 5:begin podbor_kandidaturi(5);
 vmenu:=-1;
 end;
 end;
 end;
 until vmenu>-1;
end.

hon · 22.12.2012, 22:35

Ну это и код. Ужас, а не код. Вы бы прикрепили базы данных, ошибку File not found выдает при попытках регистрации, удаления... И еще желательно исправить опечатки.
Вот автоматически отформатированный код:

Код:

uses crt;
type
   ps=^info;
   info=record
      rn: word;
      FIO: string;
      KL: string[20];
      DR: string[10];
      MR: string[20];
      rost: byte;
      CG: string[10];
      CV: string[10];
      PP: string[20];
      OP: string[50];
      MN: string[30];
      l, r: ps;
   end;
var
   F, f1, fa: file of info;
   Buf, b2: info;
   t, top, s, n, k, pa, p: ps;
   gmenu, vmenu, i, zz,
      q, j, m, flag, nrn, nom, sch: integer;
   key, h, v: char;
   menu: array[0..16] of string;

procedure ramka(xx, yy, g, w, c, cs, d, p: integer; cv, pr: string);
var
   a, j, x, y: integer;
begin
   x:=xx+2; y:=yy+2;
   gotoxy(x, y); textcolor(15); write(PR);
   a:=length(cv);
   if cv='' then a:=0;
   textcolor(c);
   gotoxy(xx, yy);
   if d=1 then
      write('+') else write('+');
   for j:=1 to trunc((g/2)-(a/2)) do if d=1 then
         write('-') else write('-');
   textcolor(cs); write(cv);
   textcolor(c);
   for i:=1 to trunc((g/2)-(a/2)) do if d=1 then
         write('-') else write('-');
   if d=1 then
      write('+') else write('+');
   for i:=1 to w do begin
      gotoxy(xx, yy+i);
      textcolor(c);
      if d=1 then
         write('│') else write('│');
      gotoxy((g+xx+1), yy+i);
      if d=1 then
         write('│') else write('│');
   end;
   gotoxy(xx, w+yy);
   if d=1 then
      write('+') else write('+');
   for j:=1 to(trunc((g/2)-(a/2))*2+a) do if d=1 then
         write('-') else write('-');
   if d=1 then
      write('+') else write('+'); gotoxy(80, 1);
   if p=1 then readln;
end;

procedure arxiv;
begin
   clrscr;
{rewrite(fa);}
   ramka(3, 1, 73, 14, 12, 14, 1, 0, ' АРХИВ ', '');
   gotoxy(10, 3); textcolor(11);
   write('Введите регитсрационный номер "завязавшего" №= ');
   readln(nom);
   rewrite(f1); reset(fa); reset(f); flag:=0;
   if filesize(fa)<>0 then seek(fa, filesize(fa));
   repeat
      read(f, b2);
      if (b2.rn<>nom) then write(f1, b2)
      else begin
         write(fa, b2);
         Flag:=1;
      end;
   until eof(f);
   if flag=0 then
   begin
      sound(600);
      delay(2222);
      nosound;
      textbackground(4);
      ramka(26, 7, 32, 4, 14, 9, 1, 1, ' ОШИБКА', 'НЕВОЗМОЖНО ВЫПОЛНИТЬ ОПЕРАЦИЮ');
      textbackground(0);
   end
   else
   begin
      sound(3100);
      delay(2222);
      nosound;
      textbackground(1);
      ramka(28, 8, 32, 4, 14, 9, 1, 1, ' DELETE', 'ПРЕСТУПНИК ПЕРЕМЕЩЁН В АРХИВ');
      textbackground(0);
   end;
   CLRSCR;
   close(f); close(f1); close(fa);
   if flag=1 then
   begin
      erase(f);
      assign(f, 'interp1.dat');
      rename(f, 'interp.dat');
   end;
   clrscr;
end;

procedure main(x, y: integer; s: string; select: integer);
var
   colorbg: integer;
begin
   gotoxy(x, y);
   if select=1 then colorbg:=7
   else colorbg:=15;
   if select=2 then colorbg:=11;
   if select=3 then colorbg:=7;
   if select=4 then colorbg:=1;
   textcolor(colorbg);
   textbackground(0);
   writeln(s);
end;

procedure podbor_kandidaturi(wer: integer);
begin
   ramka(3, 1, 74, 16, 11, 15, 1, 0, ' ПОДБОР КАНДИДАТУРЫ ', '');
   reset(f);
   if wer=1 then begin gotoxy(7, 2); write('Введите ФИО - '); readln(b2.FIO); end;
   if wer=2 then begin gotoxy(7, 2); write('Введите кличку - '); readln(b2.KL); end;
   if wer=3 then begin gotoxy(7, 2); write('Введите дату рождения - '); readln(b2.DR); end;
   if wer=4 then begin gotoxy(7, 2); write('Введите рост - '); readln(b2.rost); end;
   if wer=5 then begin gotoxy(7, 2); write('Введите цвет волос - '); readln(b2.CV); end;
   textcolor(14);
   repeat
      read(f, buf);
      if ((b2.FIO=buf.FIO)or(b2.KL=buf.KL)or
         (b2.DR=buf.DR)or(b2.rost=buf.rost)or(b2.CV=buf.CV)) then
      begin
         gotoxy(7, 3);
         writeln('Подходящая кандидатура'); gotoxy(5, 5);
         write('Регистрационный номер - ', buf.rn); gotoxy(5, 6);
         write('ФИО - ', buf.FIO); gotoxy(5, 7);
         write('Кличка - ', buf.KL); gotoxy(5, 8);
         write('Дата рождения - ', buf.DR); gotoxy(5, 9);
         write('Место рождения - ', buf.MR); gotoxy(5, 10);
         write('Рост - ', buf.rost); gotoxy(5, 11);
         write('Цвет глаз - ', buf.CG); gotoxy(5, 12);
         write('Цвет волос - ', buf.CV); gotoxy(5, 13);
         write('Преступная профессия - ', buf.PP); gotoxy(5, 14);
         write('Особые приметы - ', buf.OP); gotoxy(5, 15);
         write('Место нахождение - ', buf.MN);
      end;
   until eof(f);
   readln;
   close(f);
   clrscr;
end;

procedure Spisok_Zav;
begin
   reset(fa);
   ramka(3, 1, 73, 16, 9, 15, 1, 0, ' СПИСОК ЗАВЯЗАВШИХ ', '');
   textcolor(14);
   repeat
      read(fa, buf);
      gotoxy(5, 4);

hon · 22.12.2012, 22:38

Код:

      write('Регистрационный номер - ', buf.rn); gotoxy(5, 5);
      write('ФИО - ', buf.FIO); gotoxy(5, 6);
      write('Кличка - ', buf.KL); gotoxy(5, 7);
      write('Дата рождения - ', buf.DR); gotoxy(5, 8);
      write('Место рождения - ', buf.MR); gotoxy(5, 9);
      write('Рост - ', buf.rost); gotoxy(5, 10);
      write('Цвет глаз - ', buf.CG); gotoxy(5, 11);
      write('Цвет волос - ', buf.CV); gotoxy(5, 12);
      write('Преступная профессия - ', buf.PP); gotoxy(5, 13);
      write('Особые приметы - ', buf.OP); gotoxy(5, 14);
      write('Место нахождение - ', buf.MN);
      gotoxy(80, 1);
      readln;
   until eof(fa);
   close(fa);
   clrscr;
end;

procedure REGISTRATION;
begin
 { rewrite(f); }
   reset(f);
   repeat
      ramka(3, 1, 73, 19, 9, 14, 1, 0, ' РЕГИСТРАЦИЯ ', '');
      textcolor(7);
      gotoxy(5, 2);
      write(' Зарегистрировать нового преступника, Да-d; Нет-n / ');
      readln(h);
      textcolor(12);
      if filesize(f)<>0 then seek(f, filesize(f));
      if (h='d')or(h='D') then begin
         gotoxy(5, 4);
         write('Введите регистрационный номер - '); readln(buf.rn); gotoxy(5, 5);
         write('Введите ФИО - '); readln(buf.FIO); gotoxy(5, 6);
         write('Введите кличку - '); readln(buf.KL); gotoxy(5, 7);
         write('Введите дату рождения - '); readln(buf.DR); gotoxy(5, 8);
         write('Введите место рождения - '); readln(buf.MR); gotoxy(5, 9);
         write('Введите рост - '); readln(buf.rost); gotoxy(5, 10);
         write('Введите цвет глаз - '); readln(buf.CG); gotoxy(5, 11);
         write('Введите цвет волос - '); readln(buf.CV); gotoxy(5, 12);
         write('Введите преступную профессию - '); readln(buf.PP); gotoxy(5, 13);
         write('Введите особые приметы - '); readln(buf.OP); gotoxy(5, 14);
         write('Введите место нахождения - '); readln(buf.MN);
      end;
      zz:=0;
      if (filesize(f)<>0)and((h='d')or(h='D')) then
      begin
         reset(f);
         repeat
            read(f, b2);
            if (b2.rn=buf.rn)and(b2.FIO=buf.FIO) then zz:=1;
         until eof(f);
         if zz=1 then
         begin
            sound(600);
            delay(2222);
            nosound;
            textbackground(4);
            ramka(41, 7, 28, 4, 15, 14, 2, 1, 'ОШИБКА', 'ПРЕСТУПНИК УЖЕ СУЩЕСТВУЕТ');
            textbackground(0);
         end else write(f, buf);
      end;
   until (h<>'d')or(h<>'D');
   clrscr;
   close(F);
end;

procedure PROSMOTR;
begin
   ramka(3, 1, 74, 16, 11, 15, 1, 0, ' ПРОСМОТР ', '');
   reset(f);
   top:=nil;
   while not eof(f) do
   begin
      new(n);
      read(f, buf);
      n^.l:=nil;
      n^.r:=top;
      if t<>nil then t^.l:=n;
      n^.rn:=buf.rn; n^.FIO:=buf.FIO; n^.KL:=buf.KL;
      n^.DR:=buf.DR; n^.MR:=buf.MR; n^.rost:=buf.rost;
      n^.CG:=buf.CG; n^.CV:=buf.CV; n^.PP:=buf.PP;
      n^.OP:=buf.OP; n^.MN:=buf.MN;
      t:=top;
      top:=n;
   end;
   t:=top;
   p:=nil;
   while t<>nil do
   begin
      if p<>nil then
      begin
         if p^.rn>t^.rn then
         begin
            p^.r:=t^.r;
            pa:=t^.r;
            pa^.l:=p;
            t^.r:=top;
            t^.l:=nil;
            top^.l:=t;
            top:=t;
         end;
      end;
      p:=t;
      t:=t^.r;
   end;
   t:=top; flag:=0; sch:=6;
   while t<>nil do
   begin
      textcolor(14);
      if flag=0 then begin
         gotoxy(5, 4);
         writeln(' Ф И О ', ' Дата рождения ');
         writeln(' |---------------------------------|');
      end;
      gotoxy(10, sch);
      write(t^.FIO, ' ', t^.DR); {gotoxy(5,6); }
      t:=t^.r; sch:=sch+1; flag:=1;
   end;
   readln;
   clrscr;
end;

procedure DELETE;
begin
   clrscr;
   ramka(13, 10, 52, 4, 12, 13, 1, 0, ' Выбирите ', '');
   gotoxy(15, 11); textcolor(11);
   writeln('Если преступник "Завязал" нажмите клавишу:пробел ');
   gotoxy(15, 12); textcolor(11);
   writeln('Если преступник "откинул капыта" нажмите :ENTER ');
   gotoxy(15, 13); write('|=');
   readln(v);
   if ord(v)=32 then arxiv else
   begin
      clrscr;
      ramka(3, 1, 73, 19, 9, 14, 1, 0, ' УДАЛЕНИЕ ', '');
      gotoxy(20, 3); textcolor(12);
      write('Введите регистрационный номер преступника:'); {gotoxy(15,2); }
      readln(nrn);
      reset(f); rewrite(f1); flag:=0;
      repeat
         read(f, b2);
         if (b2.rn<>nrn) then write(f1, b2)
         else flag:=1;
      until eof(f);
      if flag=0 then
      begin
         sound(600);
         delay(2222);
         nosound;
         textbackground(4);
         ramka(28, 7, 24, 4, 15, 14, 1, 1, 'ОШИБКА', 'ПРЕСТУПНИК ОТСУТСТВУЕТ');
         textbackground(0);
      end
      else

hon · 22.12.2012, 22:39

Код:

      begin
         sound(3100);
         delay(2222);
         nosound;
         textbackground(1);
         ramka(28, 8, 20, 4, 15, 14, 1, 1, 'DELETE', 'ПРЕСТУПНИК УДАЛЁН');
         textbackground(0);
      end;
      CLRSCR;
      close(f);
      erase(f);
      close(f1);
      assign(f, 'interp1.dat');
      rename(f, 'interp.dat');
   end;
   clrscr;
end;

procedure screen(c: integer);
begin
   textbackground(c);
   clrscr;
end;
begin
   assign(f, 'interp.dat');
   assign(f1, 'interp1.dat');
   assign(fa, 'arxiv_interpol.dat');
   screen(0);
   menu[0]:=' ';
   menu[1]:=' ПРЕСТУПНИКИ ';
   menu[2]:=' ПОИСК ';
   menu[3]:=' ПОДБОР КАНДИДАТУРЫ ';
   menu[4]:=' Регистрация ';
   menu[5]:=' Удалить ';
   menu[6]:=' Выход ';
   menu[7]:=' Вывод всей базы ';
   menu[8]:=' Архив ';
   menu[9]:=' По ФИО ';
   menu[10]:=' По кличке ';
   menu[11]:=' По росту ';
   menu[12]:=' По дате рождения ';
   menu[13]:=' По цвету волос ';
   menu[14]:=' ';
   menu[15]:=' ';
   gmenu:=1;
   repeat
      gotoxy(1, 1);
      textcolor(0);
      textbackground(0); {textattr:=79;}
      ramka(3, 1, 74, 1, 9, 14, 1, 0, ' КАРТОТЕКА ИНТЕРПОЛА ', '');
      repeat
         if gmenu=1 then begin
            main(7, 2, menu[1], 0);
            main(35, 2, menu[2], 1);
            main(54, 2, menu[3], 1);
            gotoxy(80, 2);
         end;
         if gmenu=2 then begin
            main(7, 2, menu[1], 1);
            main(35, 2, menu[2], 0);
            main(54, 2, menu[3], 1);
            Gotoxy(80, 2);
         end;
         if gmenu=3 then begin
            main(7, 2, menu[1], 1);
            main(35, 2, menu[2], 1);
            main(54, 2, menu[3], 0); gotoxy(80, 2);
         end;
         key:=Readkey;
         case key of
            #77: begin
                  gmenu:=gmenu+1;
                  if gmenu>3 then gmenu:=1;
               end;
            #75: begin
                  gmenu:=gmenu-1;
                  if gmenu<1 then gmenu:=3;
               end;
         end;
      until key=#13;
      case gmenu of
         1: begin
               vmenu:=1;
               repeat
                  if vmenu=1 then
                  begin
                     main(8, 3, menu[0], 4);
                     main(8, 4, menu[4], 2);
                     main(8, 5, menu[5], 3);
                     main(8, 6, menu[6], 3);
                     main(8, 7, menu[0], 4);
                     ramka(7, 3, 14, 4, 12, 14, 2, 0, '', '');
                     gotoxy(80, 2);
                  end;
                  if vmenu=2 then
                  begin
                     main(8, 4, menu[4], 3);
                     main(8, 5, menu[5], 2);
                     main(8, 6, menu[6], 3); gotoxy(80, 2);
                  end;
                  if vmenu=3 then
                  begin
                     main(8, 4, menu[4], 3);
                     main(8, 5, menu[5], 3);
                     main(8, 6, menu[6], 2); gotoxy(80, 2);
                  end;
                  key:=Readkey;
                  case key of
                     #80: begin vmenu:=vmenu+1;
                           if vmenu>3 then vmenu:=1;
                        end;
                     #72: begin vmenu:=vmenu-1;
                           if vmenu<1 then vmenu:=3;
                        end;
                     #27: begin screen(0); vmenu:=-1;
                        end;
                     #13: begin screen(0);
                        end;
                  end;
               until (key=#13)or(key=#27);
            end;
         2: begin
               vmenu:=1;
               repeat
                  if vmenu=1 then begin
                     main(35, 3, menu[14], 4);
                     main(35, 4, menu[7], 2);
                     main(35, 5, menu[8], 3);
                     main(35, 6, menu[14], 4);
                     ramka(34, 3, 22, 3, 12, 14, 2, 0, '', '');
                     gotoxy(80, 2);
                  end;
                  if vmenu=2 then
                  begin
                     main(35, 4, menu[7], 3);
                     main(35, 5, menu[8], 2); gotoxy(80, 2);
                  end;
                  key:=Readkey;
                  case key of
                     #80: begin vmenu:=vmenu+1;
                           if vmenu>2 then vmenu:=1;
                        end;
                     #72: begin vmenu:=vmenu-1;
                           if vmenu<1 then vmenu:=2;
                        end;
                     #27: begin screen(0); vmenu:=-1;
                        end;
                     #13: begin screen(0);
                        end;
                  end;
               until (key=#13)or(key=#27);
            end;

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
коментарии	Licwin	Паскаль, Turbo Pascal, PascalABC.NET	0	01.07.2011 10:02
По с++ коментарии	1Илья1	Помощь студентам	5	11.04.2011 17:51
коментарии к коду С++	dymych	Помощь студентам	0	09.11.2010 16:35
обьяснения (коментарии) к коду:	Programmer20101	Общие вопросы Delphi	12	18.05.2010 18:36
C++. нужни коментарии к коду программы	Myau Thai	Помощь студентам	1	04.06.2009 19:32