Тестирование и анализ результатов

После запуска программы на экране появляется графическая информационная

заставка (Рис. 4.1.).

После нажатия клавиши ENTER, на экране появляется горизонтальное меню (рис.4.2)

Рис. 4.2. Горизонтальное меню и информация.

Видно, что активный пункт меню - Новая. Нажимая клавиши управления курсором, перемещаюсь по пунктам меню. На пункте меню Новая нажимаю клавишу ENTER, на экране выводится сообщение (рис.4.3):

Рис. 4.3. Запрос на новую запись.

Ввожу следующую информацию:

Шифр
Фамилия	Петровский
Специальность	АСОИ
Имя	Евгений
Отчество	Иванович
Год поступления

После ввода информации и нажатия клавиши ENTER, появляется запрос (рис.4.4). Нажимаю НЕТ - появляется первоначальная заставка (рис 4. 2.). Добавленную запись мы сразу же видим на экране.

Рис.4.4 Добавление записи.

Если бы мы нажали клавишу ДА, появилось снова бы сообщение (рис.4.3.).

Выход в главное меню при неполном заполнении записи осуществляется путём нажатия клавиши ESC.

Нажав клавишу TAB, видим, что появилась полная информация об окне (рис.4.5), расположенном первым по списку, нажимая клавиши ↓↑, мы перемещаемся по записям и наблюдаем полную информацию о каждом.

Рис. 4.5. Полная информация о записях.

При нажатии клавиш: DEL - появляется запрос (рис. 4.6.), ENTER - появляется такой же запрос, как и при создании новой записи (рис 4.3.), но поля уже содержат данные, INS –запрос о подтверждении переноса в архив (рис. 4.7.).

Рис. 4.6. Удаление записи

Рис 4.7. Перенос записи в архив.

Нажимаем клавишу ESC и возвращаемся в главное меню, выбираем пункт Поиск. Критерий поиска – любое поле записи (если же не указаны искомые данные, система выведет всю базу данных). Найдём всех студентов, факультета «АСОИ» (рис. 4.8.). В том случае, если программа не найдет записей по исходному запросу, то появится сообщение «Ничего не найдено!».

Рис. 4.8. Заполнение ключевых полей поиска.

Результат (рис.4.9), затем клавишей ESC возвращаемся в главное меню, выбираем пункт Сортировка. Появляется запрос (рис.4.10), перемещаясь с помощью клавиш ↓↑ выбираем сортируемое поле, например фамилия, результат (рис. 4.11.)

Рис. 4.9. Результат поиска.

Рис. 4.10. Запрос на сортировку.

Рис. 4.11. Результат сортировки.

Опять же клавишей ESC возвращаемся в главное меню, выбираем пункт Архив.

Нажимаем клавишу ENTER и просматриваем содержимое архива (поскольку мы не заносили туда никакой информации – результат пустой список). Возвращаемся в главное меню клавишей ESC, выбираем пункт Автор и нажимаем ENTER(рис 4.12.). Возвращение в главное меню – клавиша ESC.

Рис. 4.12. Краткая информация об авторе.

При выборе пункта меню Выход, мы возвращаемся в среду TP.

ЗАКЛЮЧЕНИЕ

 

В результате выполнения курсовой работы был разработан алгоритм реализации и написана программа для информационной системы «Учреждение образования». Данная программа позволяет создать базу данных, хранящую в себе данные о студентах (учащихся), таких как шифр, фамилия, имя, отчество, специальность, год поступления. Обеспечена возможность добавление записей, их редактирование и удаление.

В итоге программа оказалась нетребовательной к ресурсам компьютера и может легко использоваться на недорогих ЭВМ. Также, для лучшего использования программа имеет удобный интерфейс и понятный любому пользователю диалоговый режим. В ходе проделанной работы была построена гибкая модель базы данных, в которой легко создать нужный запрос; данные представлены в удобном для пользователя виде.

Пояснительная записка содержит подробное описание процесса проектирования и создания, как базы данных, так и программного обеспечения, работающего с ней.

Так как программа работает с динамическими списками, то она быстра и позволяет избежать избыточности данных в таблицах.

В дальнейшем программа может быть усовершенствована путем добавления новых функций и модулей, например, для применения в более профессиональной среде и вывода на печать файла с информацией о студентах (учащихся). Это сможет значительно расширить область применения программы и сделать ее еще более востребованной.

СПИСОК ЛИТЕРАТУРЫ

 

- Вальвачев А.Н., Крисевич В.С. Программирование на языке ПАСКАЛЬ для персональных ЭВМ ЕС: Справочное пособие. – Мн.: Выш. шк., 1989.

- Базенков Т.Н., Дереченик С.С. СТ БПИ – 02 – 98. Графическая конструкторская документация электронной аппаратуры в курсовых и дипломных проектах (работах): Общие требования к разработке и правила оформления. – Брест, 1998.

- ГОСТ 19.002 – 80 ЕСПД Схемы алгоритмов и программ. Правила выполнения. – М.: Издательство стандартов, 1990.

- ГОСТ 19.003 – 80 ЕСПД Схемы алгоритмов и программ. Обозначения условные и графические. – М.: Издательство стандартов, 1990.

- ГОСТ 19.701 – 90 ЕСПД Схемы алгоритмов, программ, данных и систем. Условные обозначения и правила выполнения. – М.: Издательство стандартов, 1990.

- СТБПИ – 02 – 98 Стандарты института. Графическая конструкторская и программная документация электронной аппаратуры в курсовых и дипломных проектах (работах). Общие требования к разработке и правила оформления. – Брест: БПИ, 1998.

- Епанешников А.М., Епанешников В.А.. «Программирование в среде TURBO PASCAL 7.0». Москва, «Диалог-мифи», 1996. Вальвачев А.Н., Крисевич В.С.. «Программирование на языка ПАСКАЛЬ». Минск, «Вышэйшая школа», 1989

ПРИЛОЖЕНИЕ 1. БЛОК-СХЕМА АЛГОРИТМА

 

ПРИЛОЖЕНИЕ 2. ТЕКСТ ПРОГРАММЫ

 

Program kurs;

uses crt;

Type

Record_Base=record {тип данных mag представляющий из себя запись с 6-ю переменными}

Record_Number:String[9]; {Шифр Студента}

Record_Famile:string[40]; {Фамилия}

Record_Special:string[20]; {Специальность}

Record_Name:string[20]; {Имя}

Record_Fathername:String[15]; {Отчество}

Record_Year:String[20]; {Год поступления}

end;

FileType=file of Record_Base;

Const

MENU1_Q=6;

MENU1_S:array[0..MENU1_Q-1] of string[25] = ('Новая','Поиск','Сортировка','Архив','Автор','Выход');

MENU2_S:array[1..6] of string[30] =

('Шифр: ','Фамилия: ','Специал.: ','Имя: ','Отчество: ','Год пост.: ');

FILENAME:string = 'Base.imm';ARCHIVNAME:string = 'Archiv.rar';

STR1='╔═ ДЕТАЛИ ════════════════════╗';

STR2='╔═ КРАТКИЕ ДАННЫЕ ══════════════════════════════╗';

STR3='╔═ ИНФОРМАЦИЯ ════════════════╗';

Var

c:char;

z:word;

cod1,cod2,cod3,cod4,c1,c2,c3,c4,i,last1,last2,lastfile:integer;

s:string;

f,f1:FileType;

Man:Record_Base;

ramka,n,flag,archiv:boolean;

 

Procedure enter(x,y:integer;max:integer;mode:string;var flag:boolean;var str:string);

var s:string; c:char;

Begin

s:=mode; while keypressed do c:=readkey;

repeat gotoxy(x,y); for i:=1 to max do write(' '); gotoxy(x,y); write(s);

repeat c:=readkey;if ord(c)=0 then begin c:=readkey; c:=#0; end; until (ord(c)<>0);

case ord(c) of 8: delete(s,length(s),1); end;

if (length(s)<max) and (ord(c)<>8) and (ord(c)<>13) then s:=s+c;

until (ord(c)=13) or (ord(c)=27); flag:=c=#27;

str:=s;

End;

 

Procedure Panel(var x:integer;var n:word);

var leng,i,j:word; c:char;

Begin

Window(1,1,80,1); leng:=80 div MENU1_Q;

Repeat window(2,18,Length(STR1)-1,23); textattr:=$0f;

clrscr; gotoxy(2,2); write('Нажмите "Tab", чтобы увидеть');

gotoxy(5,3); write('полную информацию');

gotoxy(6,4); write('или "Enter", чтобы '); textattr:=$0f;

case x of

0:begin gotoxy(1,5);write('добавить новую запись в базу');end;

1:begin gotoxy(5,5);write('найти запись в базе');end;

2:begin gotoxy(3,5);write('сортировать записи в базе');end;

3:begin gotoxy(1,5);if archiv then write(' просмотреть содержимое базы')

else write('просмотреть содержимое архива');end;

4:begin gotoxy(2,5);write('увидеть информацию об авторе');end;

5:begin gotoxy(6,5);write('выйти из программы');end;

end;

window(1,1,80,1); textattr:=$07;

clrscr; textattr:=$1b;

for i:=0 to MENU1_Q-1 do begin

if x=i then textattr:=$3f; for j:=1 to (leng-length(MENU1_S[i])) div 2 do

write(' '); write(MENU1_S[i]);

for j:=1 to (leng-length(MENU1_S[i])) div 2 do

write(' '); textattr:=$1b; end;

c:=readkey;if ord(c)=0 then c:=readkey; case ord(c) of

77: x:=(x+1)*ord(x<>MENU1_Q-1);

75: x:=(x-1)*ord(x<>0)+(MENU1_Q-1)*ord(x=0);

9: n:=111

else n:=x;

end;

Until (ord(c)=27) or (ord(c)=13) or (ord(c)=9);

TextAttr:=$07; Window(1,1,80,50); if ord(c)=27 then halt;

End;

 

Function windows(x,y:integer;height,widgth,mode:integer;message:string):boolean;

const

STR:array [1..1] of string[20] = (' ВНИМАНИЕ! ');

Button1=' ДА '; Button2=' НЕТ '; Button3=' OK ';

var

p:pointer; i,j,k:integer; c:char; t:boolean; oldmaxx,oldmaxy,oldminx,oldminy:integer;

cur1,cur2:byte;

Begin

oldmaxx:=lo(windmax)+1; oldmaxy:=hi(windmax)+1;

oldminx:=lo(windmin)+1; oldminy:=hi(windmin)+1;

randomize; window(1,1,80,25); getmem(p,(height+1)*(widgth+2)*2);

{Save window} for i:=0 to height do for j:=0 to (widgth+2)*2-1 do

move(ptr(segb800,80*2*(y+i-1)+x*2-2+j)^,ptr(seg(p^),ofs(p^)+i*((widgth+2)*2)+j)^,1);

{Print window} textattr:=$1b; window(x,y,x+widgth-1,y+height-1);

clrscr; window(1,1,80,25); gotoxy(x+(widgth-length(message)) div 2,y+1);write(message);

gotoxy(x,y);write(#201); for i:=1 to round((widgth-length(STR[mode])-2)/2) do

Write(#205); write(STR[mode]); for i:=1 to (widgth-length(STR[mode])-2) div 2 do

Write(#205); write(#187);

for i:=1 to height-2 do

begin

gotoxy(x,y+i);write(#186); gotoxy(x+widgth-1,y+i);write(#186);

end;

gotoxy(x,y+height-1); write(#200);

for i:=1 to widgth-2 do Write(#205); write(#188);

{Making dark area}

j:=$08; for i:=1 to height-1 do

for k:=0 to 1 do move(j,ptr(segb800,80*2*(y-1+i)+(x+k)*2+widgth*2-1)^,1);

for i:=1 to widgth do move(j,ptr(segb800,80*2*(y+height-1)+(x+1)*2+i*2-1)^,1);

t:=true; case mode of

1:

begin

Repeat

if t=true then textattr:=$3f else textattr:=$07;

gotoxy(x+3,y+3);write(Button1); if t=false then textattr:=$3f else textattr:=$07;

gotoxy(x+widgth-3-length(Button2),y+3);write(Button2);

c:=readkey; case ord(c) of 75: t:=true; 77: t:=false; end;

Until (ord(c)=13) or (ord(c)=27) or (ord(c)=32);

if ord(c)=27 then t:=false; end;

2:

repeat textattr:=$3b;

gotoxy(Widgth div 2+x-length(Button3) div 2,height div 2+1+y);write(Button3);

c:=readkey; until (ord(c)=27) or (ord(c)=13) or (ord(c)=32);

end; {Print old window}

for i:=0 to height do for j:=0 to (widgth+2)*2-1 do

move(ptr(seg(p^),ofs(p^)+i*((widgth+2)*2)+j)^,ptr(segb800,80*2*(y+i-1)+x*2+j-2)^,1);

dispose(p); window(oldminx,oldminy,oldmaxx,oldmaxy);

windows:=t;

End;

 

Procedure windows_enter(x,y:integer;height,widgth:integer;mode:integer;var man:Record_Base;var flag,l:boolean);

const

STRin=' Пожалуйста, введите информацию ';

var

p:pointer; i,j,k:integer; c:char; oldmaxx,oldmaxy,oldminx,oldminy:integer;

cur1,cur2:byte; str:string;

Begin

oldmaxx:=lo(windmax)+1; oldmaxy:=hi(windmax)+1;

oldminx:=lo(windmin)+1; oldminy:=hi(windmin)+1;

asm

mov ah,03h

int 10h

mov cur1,ch

mov cur2,cl

end;

window(1,1,80,25); getmem(p,(height+1)*(widgth+2)*2);

{Save window} for i:=0 to height do for j:=0 to (widgth+2)*2-1 do

move(ptr(segb800,80*2*(y+i-1)+x*2-2+j)^,ptr(seg(p^),ofs(p^)+i*((widgth+2)*2)+j)^,1);

{Print window}

textattr:=$1b; window(x,y,x+widgth-1,y+height-1);

clrscr; window(1,1,80,25); gotoxy(x,y);write(#201);

for i:=1 to round((widgth-length(STRin)-2)/2) do Write(#205);

write(STRin); for i:=1 to (widgth-length(STRin)-2) div 2 do

Write(#205); write(#187);

for i:=1 to height-2 do begin gotoxy(x,y+i);write(#186);

gotoxy(x+widgth-1,y+i);write(#186); end;

gotoxy(x,y+height-1); write(#200); for i:=1 to widgth-2 do Write(#205);

write(#188); {Making dark area} j:=$08;

for i:=1 to height-1 do for k:=0 to 1 do

move(j,ptr(segb800,80*2*(y-1+i)+(x+k)*2+widgth*2-1)^,1);

for i:=1 to widgth do move(j,ptr(segb800,80*2*(y+height-1)+(x+1)*2+i*2-1)^,1);

for i:=1 to 12 do

begin

gotoxy(x+3,y+i); write(MENU2_S[i]); end;

if (mode=1) or (mode=2) then with man do begin

Record_Number:='';Record_Famile:='';

Record_Special:='';Record_Name:='';Record_Fathername:='';Record_Year:='';

end; textattr:=$1f; with man do begin

Gotoxy(Length(MENU2_S[1])+x+3,1+y);Write(Record_Number);

Gotoxy(Length(MENU2_S[2])+x+3,2+y);Write(Record_Famile);

Gotoxy(Length(MENU2_S[3])+x+3,3+y);Write(Record_Special);

Gotoxy(Length(MENU2_S[4])+x+3,4+y);Write(Record_Name);

Gotoxy(Length(MENU2_S[5])+x+3,5+y);Write(Record_Fathername);

Gotoxy(Length(MENU2_S[6])+x+3,6+y);Write(Record_Year);

end;

With Man do

begin if (mode=1) or (mode=3) then

Repeat Enter(x+3+Length(MENU2_S[1]),y+1,15,Record_Number,flag,Str);

if (length(Str)=0) and (not flag) then windows(23,9,5,36,2,'Это поле обязательно для ввода!'); textattr:=$1f;

until (length(Str)<>0) or flag else

Enter(x+3+Length(MENU2_S[1]),y+1,15,'',flag,Str);

Record_Number:=str; if (mode=1) or (mode=3) then

Repeat if not flag then

Enter(x+3+Length(MENU2_S[2]),y+2,20,'',flag,Str);

if (length(Str)=0) and (not flag) then windows(23,9,5,36,2,'Это поле обязательно для ввода!'); textattr:=$1f;

until (length(Str)<>0) or flag else if not flag then

Enter(x+3+Length(MENU2_S[2]),y+2,20,'',flag,Str);

Record_Famile:=str; if not flag then

Enter(x+3+Length(MENU2_S[3]),y+3,20,Record_Special,flag,str);Record_Special:=str;

if not flag then

Enter(x+3+Length(MENU2_S[4]),y+4,20,Record_Name,flag,str);Record_Name:=str;

if not flag then

Enter(x+3+Length(MENU2_S[5]),y+5,15,Record_Fathername,flag,str);Record_Fathername:=str;

if not flag then

Enter(x+3+Length(MENU2_S[6]),y+6,18,Record_Year,flag,str);Record_Year:=str;

end;

textattr:=$0b; if mode=1 then

l:=windows(23,9,5,30,1,'Продолжать вводить записи?');

{Print old windows} for i:=0 to height do for j:=0 to (widgth+2)*2-1 do

move(ptr(seg(p^),ofs(p^)+i*((widgth+2)*2)+j)^,ptr(segb800,80*2*(y+i-1)+x*2+j-2)^,1);

dispose(p); window(oldminx,oldminy,oldmaxx,oldmaxy);

End;

 

Procedure windows_sort(x,y:integer;height,widgth:integer;var flag:boolean;var n:integer);

const STRin=' Выберите поле сортировки ';

var p:pointer; i,j,k:integer; c:char; oldmaxx,oldmaxy,oldminx,oldminy:integer;

cur1,cur2:byte; str:string;

Begin

oldmaxx:=lo(windmax)+1; oldmaxy:=hi(windmax)+1; oldminx:=lo(windmin)+1;

oldminy:=hi(windmin)+1; window(1,1,80,25); getmem(p,(height+1)*(widgth+2)*2);

{Save window} for i:=0 to height do for j:=0 to (widgth+2)*2-1 do

move(ptr(segb800,80*2*(y+i-1)+x*2-2+j)^,ptr(seg(p^),ofs(p^)+i*((widgth+2)*2)+j)^,1);

{Print window} textattr:=$1b; window(x,y,x+widgth-1,y+height-1); clrscr;

window(1,1,80,25); gotoxy(x,y);write(#201); for i:=1 to round((widgth-length(STRin)-2)/2) do

Write(#205); write(STRin); for i:=1 to (widgth-length(STRin)-2) div 2 do

Write(#205); write(#187); for i:=1 to height-2 do begin

gotoxy(x,y+i);write(#186); gotoxy(x+widgth-1,y+i);write(#186); end;

gotoxy(x,y+height-1); write(#200); for i:=1 to widgth-2 do Write(#205);

write(#188); {Making dark area} j:=$08; for i:=1 to height-1 do for k:=0 to 1 do

move(j,ptr(segb800,80*2*(y-1+i)+(x+k)*2+widgth*2-1)^,1); for i:=1 to widgth do

move(j,ptr(segb800,80*2*(y+height-1)+(x+1)*2+i*2-1)^,1); for i:=1 to 12 do

begin gotoxy(x+3,y+i); write(MENU2_S[i]); end;

flag:=false; n:=1; textattr:=$1f; repeat gotoxy(x+23,y+n); write(#17,#205,#205,#205); c:=readkey;if ord(c)=0 then c:=readkey; gotoxy(x+23,y+n); write(' ');

case ord(c) of 72: n:=12*ord(n=1)+(n-1)*ord(n<>1);

80: n:=1*ord(n=12)+(n+1)*ord(n<>12); end;

until (ord(c)=27) or (ord(c)=13); if ord(c)=27 then flag:=true;

textattr:=$1b; {Print old windows} for i:=0 to height do

for j:=0 to (widgth+2)*2-1 do

move(ptr(seg(p^),ofs(p^)+i*((widgth+2)*2)+j)^,ptr(segb800,80*2*(y+i-1)+x*2+j-2)^,1);

dispose(p); window(oldminx,oldminy,oldmaxx,oldmaxy);

End;

 

Procedure ramka1(Nach:integer);

var i:integer;

Begin

window(1,2,Length(STR1),16); textattr:=$0b; clrscr; window(1,2,Length(STR1),17);

textattr:=$0b; gotoxy(1,Nach); if (Nach>0) and (Nach<=22) then Write(STR1);

for i:=Nach+1 to Nach+14 do if (i>0) and (i<=22) then begin

gotoxy(1,i);write(#186); gotoxy(31,i);write(#186); end;

if (Nach+14>0) and (Nach+14<=22) then begin gotoxy(1,Nach+14); Write(#200);

for i:=1 to 29 do write(#205); write(#188); end; window(2,2,Length(STR1)-1,16);

textattr:=$0b; for i:=1 to 12 do if (i+Nach>0) and (i+Nach<22) then

begin gotoxy(1,i+Nach); write(MENU2_S[i]); end; window(1,1,80,25);

End;

 

Procedure ramka2;

Begin

window(1,1,80,25); textattr:=$0b; gotoxy(32,3); Write(STR2);

gotoxy(32,4);Write(#186,'Шифр',#25); gotoxy(44,4);Write('Фамилия');

gotoxy(64,4);Write('Специальность'); gotoxy(80,4);write(#186);

gotoxy(32,5);write(#204); for i:=1 to 47 do write(#205); write(#185);

for i:=6 to 24 do begin gotoxy(32,i);write(#186); gotoxy(80,i);write(#186);

end; gotoxy(32,25);write(#200); for i:=1 to 47 do write(#205); write(#188);

End;

 

Procedure ramka3;

var i:integer;

Begin

window(1,17,Length(STR1),25); textattr:=$0b; writeln(STR3); for i:=2 to 7 do

begin gotoxy(1,i);write(#186); gotoxy(length(STR3),i);write(#186);

end; write(#200); for i:=1 to length(STR3)-2 do write(#205);

write(#188); window(1,1,80,25);End;

 

Procedure Delete(l:integer);

var man:Record_Base;

Begin

seek(f,l+1); while not eof(f) do begin read(f,man); seek(f,filepos(f)-2); write(f,man); seek(f,filepos(f)+1); end; seek(f,filesize(f)-1); truncate(f);

End;

 

Procedure Init(FILENAME:string);

Begin

assign(f,FILENAME); {$I-} reset(f); if IOResult<>0 then

begin rewrite(f); if IOResult<>0 then begin

clrscr; writeln('Error while creating new file program will be terminated');

textcolor(red+blink); Writeln('PRESS ENTER!');

textattr:=$07; Readln; Halt(1); end; end; close(f); {$I+}

End;

 

Procedure Show_ramka;

Begin ramka:=true;

for i:=-17 to 1 do

begin window(1,2,Length(STR1),16); clrscr; ramka1(i); delay(round(sqr(i+30)));

end;

End;

Procedure Hide_Ramka;

Begin ramka:=false;

for i:=1 downto -17 do begin window(1,2,Length(STR1),16); clrscr;

ramka1(i); delay(round(sqr(i+30))); end;

End;

 

Procedure New_String;

var Man:Record_Base; i:integer; c:char; str:string; l:boolean;

Begin

reset(f); window(2,18,Length(STR1)-1,22); textattr:=$0f; clrscr; gotoxy(11,3);Write('Пожалуйста,'); gotoxy(7,4);Write('введите информацию'); window(3,3,Length(STR1)-1,15); Repeat windows_enter(15,4,14,50,1,man,flag,l);

if not flag then begin seek(f,filesize(f)); write(f,Man);

if last2+filesize(f)-lastfile-1<=19 then

begin if filesize(f)=1 then textattr:=$1f else textattr:=$0b;

window(33,5,79,23);

gotoxy(1,last2+filesize(f)-lastfile-1);clreol;write(man.Record_Number);

gotoxy(12,last2+filesize(f)-lastfile-1);write(man.Record_Famile);

gotoxy(32,last2+filesize(f)-lastfile-1);write(man.Record_Special); end;

end; Until not l; close(f);

End;

 

Procedure Fill_Ramka2(n:integer);

var i,k:integer; Man:Record_Base;

Begin

reset(f); textattr:=$0b; window(33,5,79,23); clrscr; i:=1;

While (i<20) and (not eof(f)) do begin read(f,man); if i=n then begin

textattr:=$1f; gotoxy(1,n); clreol; end;

gotoxy(1,i);write(man.Record_Number);

gotoxy(12,i);write(man.Record_Famile);

gotoxy(32,i);write(man.Record_Special);

if i=n then textattr:=$0b; inc(i); end; window(1,1,80,25); close(f);

End;

 

Procedure ramka2_move(var x,l:integer);

var c:char; k:integer; man:Record_Base; flag,h:boolean;

f1:file of Record_Base;

Begin

window(2,18,Length(STR1)-1,23); textattr:=$0f;

clrscr; gotoxy(1,2); write(#24,' или ',#25,' - двигать курсор');

gotoxy(1,3); write('"del" - удалить запись');

gotoxy(1,4); write('"Enter"-редактировать запись');

gotoxy(1,5); if archiv then write('"Ins" - перенести в базу') else

write('"Ins" - перенести в архив'); if not ramka then Show_Ramka;

reset(f); seek(f,l); if filesize(f)>0 then

begin read(f,man); seek(f,l);

end; repeat textattr:=$0f; if filesize(f)>0 then

begin window(3,3,Length(STR1)-1,16);

With Man do begin

Gotoxy(Length(MENU2_S[1]),1);clreol;Write(Record_Number);

Gotoxy(Length(MENU2_S[2]),2);clreol;Write(Record_Famile);

Gotoxy(Length(MENU2_S[3]),3);clreol;Write(Record_Special);

Gotoxy(Length(MENU2_S[4]),4);clreol;Write(Record_Name);

Gotoxy(Length(MENU2_S[5]),5);clreol;Write(Record_Fathername);

Gotoxy(Length(MENU2_S[6]),6);clreol;Write(Record_Year);

end; end else ramka1(1);

window(33,5,79,23); c:=readkey;if ord(c)=0 then c:=readkey;

if ((ord(c)=72) and (filepos(f)>0)) or ((ord(c)=80) and (filepos(f)+1<filesize(f))) and (filesize(f)>0) then begin read(f,man);

seek(f,filepos(f)-1); textattr:=$0b;

gotoxy(1,x); clreol; gotoxy(1,x);write(man.Record_Number);

gotoxy(12,x);write(man.Record_Famile); gotoxy(32,x);write(man.Record_Special);

end; case ord(c) of

72:if (filepos(f)>0) and (filesize(f)<>0) then

begin if x=1 then begin gotoxy(1,x); insline; end else dec(x);

seek(f,filepos(f)-1); read(f,man); seek(f,filepos(f)-1); end;

80:if (filepos(f)+1<filesize(f)) and (filesize(f)<>0) then begin if x=19 then

begin gotoxy(1,1); delline; end else inc(x); seek(f,filepos(f)+1); read(f,man);

seek(f,filepos(f)-1); end; 83: if filesize(f)<>0 then if windows(23,9,5,30,1,'Вы точно хотите удалить?') then

begin textattr:=$0b;

k:=filepos(f); delete(k); gotoxy(1,x); delline; if (k+19-x)<=filesize(f)-1 then

begin seek(f,k+19-x); read(f,man); seek(f,k); gotoxy(1,19);write(man.Record_Number);

gotoxy(12,19);write(man.Record_Famile); gotoxy(32,19);write(man.Record_Special);

end; if (k>filesize(f)-1) and (filesize(f)<>0) then

begin seek(f,k-1); dec(x); end else seek(f,k); if filesize(f)<>0 then

begin read(f,man); seek(f,filepos(f)-1); end;

k:=filepos(f); end;

82: if filesize(f)<>0 then begin

if archiv then h:=windows(23,9,5,30,1,'Перенести в базу?')

else h:=windows(23,9,5,30,1,'Перенести в архив?');

if h then begin {$I-} assign(f1,ARCHIVNAME); reset(f1); if IOResult<>0 then rewrite(f1);

if IOResult<>0 then halt(1); seek(f1,filesize(f1));

write(f1,man); close(f1); {$I+} k:=filepos(f);

delete(k); gotoxy(1,x); delline; if (k+19-x)<=filesize(f)-1 then

begin seek(f,k+19-x); read(f,man); seek(f,k); gotoxy(1,19);write(man.Record_Number);

gotoxy(12,19);write(man.Record_Famile); gotoxy(32,19);write(man.Record_Special);

end; if (k>filesize(f)-1) and (filesize(f)<>0) then

begin seek(f,k-1); dec(x); end else seek(f,k); if filesize(f)<>0 then begin read(f,man); seek(f,filepos(f)-1); end; k:=filepos(f); end; end; 13: begin windows_enter(15,4,14,50,3,man,flag,h); if not flag then

begin write(f,man); seek(f,filepos(f)-1); end else begin

read(f,man); seek(f,filepos(f)-1); end; end; end; if filesize(f)<>0 then

begin gotoxy(1,x); textattr:=$1f; clreol; gotoxy(1,x);write(man.Record_Number);

gotoxy(12,x);write(man.Record_Famile); gotoxy(32,x);write(man.Record_Special);

end; l:=filepos(f); until (ord(c)=9) or (ord(c)=27); seek(f,0); close(f); Hide_ramka;

window(2,18,Length(STR1)-1,23); textattr:=$1b; clrscr; window(1,1,80,25);

End;

 

Procedure About;

Begin

window(2,18,Length(STR1)-1,23); clrscr;

gotoxy(2,3); Write(' Сачевичик Алексей, АС-563 Январь 2012 ');

readkey; clrscr; window(1,1,80,25);

End;

 

Procedure Find;

var Number:array[1..1000] of word; man1,man2:Record_Base; i,max,x,k,s,p:word;d,flag,l:boolean;

Begin

window(2,18,Length(STR1)-1,23); textattr:=$0f; clrscr;

gotoxy(11,3);Write('Пожалуйста,'); gotoxy(7,4);Write('введите информацию');

textattr:=$0f; windows_enter(15,4,14,50,2,man1,flag,l);

reset(f); i:=0;if not flag thenbegin window(33,5,79,23);

clrscr; while not eof(f) do begin read(f,Man2);

d:=(Man1.Record_Number=copy(Man2.Record_Number,1,length(Man1.Record_Number))) or (Man1.Record_Number='');

d:=d and ((Man1.Record_Famile=copy(Man2.Record_Famile,1,length(Man1.Record_Famile))) or (Man1.Record_Famile=''));

d:=d and ((Man1.Record_Special=copy(Man2.Record_Special,1,length(man1.Record_Special))) or (Man1.Record_Special=''));

d:=d and ((Man1.Record_Name=copy(Man2.Record_Name,1,length(man1.Record_Name))) or (Man1.Record_Name=''));

d:=d and ((Man1.Record_Fathername=copy(Man2.Record_Fathername,1,length(man1.Record_Fathername)))

or (Man1.Record_Fathername=''));

d:=d and ((Man1.Record_Year=copy(Man2.Record_Year,1,length(man1.Record_Year))) or (Man1.Record_Year='')); if d then begin

if i=0 then textattr:=$1f else textattr:=$0b; if i<=18 then

begin gotoxy(1,i+1);clreol; gotoxy(1,i+1);write(man2.Record_Number);

gotoxy(12,i+1);write(man2.Record_Famile); gotoxy(32,i+1);write(man2.Record_Special);

end; inc(i); Number[i]:=filepos(f)-1; end; end;if i>0 then begin if not ramka then show_ramka; max:=i; i:=1; x:=1; if max<>0 then begin seek(f,Number[1]);

read(f,man1); seek(f,Number[1]); end; window(2,18,Length(STR1)-1,23); textattr:=$0f;

clrscr; gotoxy(1,2); write(#24,' или ',#25,' - двигать курсор');

gotoxy(1,3); write('"del" - удалить запись'); gotoxy(1,4);

write('"Enter"-редактировать запись'); gotoxy(1,5); if archiv then

write('"Ins" - перенести в базу') else write('"Ins" - перенести в архив');

repeat textattr:=$0f; if max<>0 then begin window(3,3,Length(STR1)-1,16);

With Man do begin

Gotoxy(Length(MENU2_S[1]),1);clreol;Write(Man1.Record_Number);

Gotoxy(Length(MENU2_S[2]),2);clreol;Write(Man1.Record_Famile);

Gotoxy(Length(MENU2_S[3]),3);clreol;Write(Man1.Record_Special);

Gotoxy(Length(MENU2_S[4]),4);clreol;Write(Man1.Record_Name);

Gotoxy(Length(MENU2_S[5]),5);clreol;Write(Man1.Record_Fathername);

Gotoxy(Length(MENU2_S[6]),6);clreol;Write(Man1.Record_Year);

end; window(33,5,79,23); end else begin window(2,3,Length(STR1)-1,16);

clrscr;ramka1(1);window(33,5,79,23); end; c:=readkey;if ord(c)=0 then c:=readkey; if ((ord(c)=72) and (i>1)) or ((ord(c)=80) and (i<max)) and (max>0) then

begin textattr:=$0b; gotoxy(1,x); clreol; seek(f,Number[i]); read(f,man1);

gotoxy(1,x);write(man1.Record_Number); gotoxy(12,x);write(man1.Record_Famile);

gotoxy(32,x);write(man1.Record_Special); end; case ord(c) of 72:if (i>1) and (max<>0) then

begin if x=1 then begin gotoxy(1,x); insline; end else dec(x);

dec(i); end; 80:if (i<max) and (max<>0) then begin

if x=19 then begin gotoxy(1,1); delline; end else inc(x); inc(i); end;

82:

if filesize(f)<>0 then begin if archiv then l:=windows(23,9,5,30,1,'Перенести в базу?')

else l:=windows(23,9,5,30,1,'Перенести в архив?'); if l then

begin {$I-} assign(f1,ARCHIVNAME); reset(f1); if IOResult<>0 then rewrite(f1);

if IOResult<>0 then halt(1); seek(f1,filesize(f1)); write(f1,man1);

close(f1); {$I+} textattr:=$0b; delete(Number[i]); for k:=1 to max do

if k>=i then if k+1<=max then Number[k]:=Number[k+1]-1; dec(max);

gotoxy(1,x); delline; if (19-x+i)<=max then begin

seek(f,Number[19-x+i]); read(f,man1); gotoxy(1,19);write(man1.Record_Number);

gotoxy(12,19);write(man1.Record_Famile); gotoxy(32,19);write(man1.Record_Special);

end; if (i>max) and (max<>0) then begin

dec(x); dec(i); end; end; end;

83: if max<>0 then if windows(23,9,5,30,1,'Вы точно хотите удалить?') then

begin textattr:=$0b; delete(Number[i]); for k:=1 to max do

if k>=i then if k+1<=max then Number[k]:=Number[k+1]-1;

dec(max); gotoxy(1,x); delline; if (19-x+i)<=max then begin

seek(f,Number[19-x+i]); read(f,man1); gotoxy(1,19);write(man1.Record_Number);

gotoxy(12,19);write(man1.Record_Famile); gotoxy(32,19);write(man1.Record_Special);

end; if (i>max) and (max<>0) then begin dec(x); dec(i); end; end;

13:

begin windows_enter(15,4,14,50,3,man1,flag,l); if not flag then

begin seek(f,Number[i]); write(f,man1); seek(f,Number[i]); end

else begin seek(f,Number[i]); read(f,man1); seek(f,Number[i]); end; end; end;

window(33,5,79,23); if max<>0 then begin gotoxy(1,x); textattr:=$1f;

clreol; seek(f,Number[i]); read(f,Man1); gotoxy(1,x);write(man1.Record_Number);

gotoxy(12,x);write(man1.Record_Famile); gotoxy(32,x);write(man1.Record_Special);

end; until (ord(c)=9) or (ord(c)=27); Hide_ramka;

end else windows(23,9,5,30,2,'Ничего не найдено!');end; close(f);

last2:=1;lastfile:=0; fill_ramka2(last2);End;

 

Procedure sort;

var

man,min,temp:Record_Base; m,i,j,l:integer; d:boolean;

Begin

reset(f); windows_sort(15,4,14,50,flag,l); if not flag then

for i:=0 to filesize(f)-1 do begin seek(f,i); read(f,min); m:=i;

seek(f,i); for j:=i to filesize(f)-1 do begin

d:=true; read(f,man); d:=(Man.Record_Number<min.Record_Number) or (l<>1);val(Man.Record_Famile,c1,cod1);val(min.Record_Famile,c2,cod2);

d:=d and ((c1<c2) or (l<>2));val(Man.Record_Special,c3,cod3);val(min.Record_Special,c4,cod4);

d:=d and ((c3<c4) or (l<>3));

d:=d and ((Man.Record_Name<min.Record_Name) or (l<>4));

d:=d and ((Man.Record_Fathername<min.Record_Fathername) or (l<>5));

d:=d and ((Man.Record_Year<min.Record_Year) or (l<>6));

if d then begin min:=man; m:=j; end; end; seek(f,i); read(f,man); temp:=man;

seek(f,i); write(f,min); seek(f,m); write(f,man); end; close(f); last2:=1;lastfile:=0;

Fill_ramka2(Last2);End;

 

Procedure Zastavka;

var i:integer;

Begin

clrscr; window(7,4,77,19); textcolor(15); textbackground(1);

writeln('╔═══════════════════════════════════════════════════════════════════╗');

writeln(chr(186),' ___ ___ ___ ____ ___ ___ ',chr(186));

writeln(chr(186),' | | | | | | | | | | | | | | | | \ / ',chr(186));

writeln(chr(186),' |__ |___| ___| |___| | | |___| |___| |___| |__ | \/ ',chr(186));

writeln(chr(186),' | | | | | | | _|___|_ | | | | | | | || / \ ',chr(186));

writeln(chr(186),' |__| | | ___| | | | || | | | | | |__|| / \ ',chr(186));

writeln(chr(186),' ',chr(186));

writeln(chr(186),' __ ____ ',chr(186));

writeln(chr(186),' | | | | | ',chr(186));

writeln(chr(186),' |__| |___| __| ',chr(186));

writeln(chr(186),' | | | | ',chr(186));

writeln(chr(186),' |___| ___| ____| ',chr(186));

writeln(chr(200),'═══════════════════════════════════════════════════════════════════',chr(188));

window(3,22,77,25); textcolor(15);textbackground(1);

writeln(' Программа разработана студентом группы АС-563,(с) Сачевичик Алексей');

writeln(' Нажмите <Enter> для продолжения'); textbackground(blue); readln;

clrscr; window(1,1,80,25)

End;

 

Procedure movetoarchiv;

Begin

if archiv then begin filename:='Base.imm'; Archivname:='archiv.rar';

menu1_s[3]:='Архив'; end else begin filename:='Archiv.rar'; Archivname:='Base.imm';

menu1_s[3]:=' База'; end; init(Filename); Fill_ramka2(1); archiv:=not archiv;

last2:=1;lastfile:=0;end;

 

Begin

clrscr;

Init(FILENAME);

asm

mov ax,0003h

int 10h

end;

ramka:=false;

TextAttr:=$1b;

Window(1,1,80,25);

zastavka;

textbackground(black);

clrscr;

ramka2;Fill_ramka2(1);

ramka3;

archiv:=false;

last2:=1;lastfile:=0;

repeat

panel(last1,z);

case z of

0:New_String;

1:Find;

2:sort;

3:MovetoArchiv;

4:About;

111:ramka2_move(last2,lastfile);

end;

until z=5;

window(1,1,80,25);

clrscr;

End.