Creator111
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Вот то,что уже сделано.Помогите доделать.
Program dog;
uses crt;
type
dog=record
Naz:string;
FIO:string;
Vozr:string;
Tem:string;
Ter:integer;
mes:byte;
end;
const
punkts:array[1..3,1..7] of string[70]=
(('Работа с файлом',
'Формирование ответов на запросы пользователя',
'Выход','','','',''),
('Вывод и редактирование файла',
'Создание нового файла',
'Дополнение файла',
'Назад',
'','',''),
('1.список кличек собак и возраст',
'2.адреса хозяев,возраст и пол собаки в порядке убывания возраста собаки',
'3.средний возраст собак',
'4.график зависимости численности собак в зависимости от возраста',
'5.круговая диаграмма иллюстрирующая возрастной состав по полу собаки',
'6.столбиковая диаграмма количества собак каждой породы',
'Назад'));
proverkas:array[0..5] of string[50]=
('Введите количество записей:',
'Введите Породу:',
'Введите Кличку:',
'Введите Возраст:',
'Введите Адрес хозяина:',
'Вветите Пол собаки:');
proverka_errors:array[0..5] of string[50]=
('Ошибка ввода',
'Ошибка ввода',
'Ошибка ввода',
'Ошибка ввода',
'Ошибка ввода',
'Ошибка ввода');
kol_punktov:array[1..3] of integer=(3,4,7);
{--------------------------------------}
procedure menu(nomer_menu,punkt0:integer);
const
x1=7;
y1=15;
x2=73;
y2=35;
x10=5;
x20=75;
y10=5;
y20=40;
var
w:dog;
punkt:integer;
k:char;
f:file of dog;
{--------------1--------------------}
procedure spis_grup;
begin
clrscr;
writeln ('список кличек');
readln;
menu(2,punkt);
end;
{------------2----------------------}
procedure stoim;
begin
clrscr;
writeln ('в порядке убывания');
readln;
menu(2,punkt);
end;
{-------------3---------------------}
procedure obem;
begin
clrscr;
writeln ('средний возраст');
readln;
menu(2,punkt);
end;
{------------4----------------------}
procedure grafik;
begin
clrscr;
writeln ('график');
readln;
menu(2,punkt);
end;
{------------5----------------------}
procedure krug;
begin
clrscr;
writeln ('круговая диаграмма');
readln;
menu(2,punkt);
end;
{------------6----------------------}
procedure stolbik;
begin
clrscr;
writeln ('столбиковая диаграмма');
readln;
menu(2,punkt);
end;
{-------------------------------------}
procedure write_punkt(color,punkt:integer);
begin
textcolor(color);
gotoxy((x2-x1+2-length(punkts[nomer_menu,punkt]))div 2,(y2-y1-kol_punktov[nomer_menu])div 2+2*(punkt-1));
write(punkts[nomer_menu,punkt]);
end;{of write_punkt}
{-------------------------------------}
procedure write_menu(nomer_menu:integer);
var
i:integer;
begin
textbackground(brown);{color}
window(1,1,80,50);
clrscr;
textbackground(black);
window(x1,y1,x2,y2);
clrscr;
for i:=1 to kol_punktov[nomer_menu] do
if i=punkt0 then write_punkt(red,i) else write_punkt(yellow,i);
end;
{of write_menu}
{-------------------------------------}
procedure write_text(text:string;y,color:integer);
begin
textcolor(color);
gotoxy((x2-x1-length(text)) div 2,y);
writeln(text);
end;
{of write text}
{-------------------------------------}
function proverka(nomer:integer):string;
const
simbols:set of char=['А'..'Я','а'..'я','.',' ','-'];
var
s:string;
n,error,i:integer;
flag:boolean;
begin
flag:=true;
repeat
clrscr;
if not(flag) then write_text(proverka_errors[nomer],14,20);
write_text(proverkas[nomer],7,yellow);
gotoxy(10,10);
readln(s);
val(s,n,error);
flag:=true;
case nomer of
0:if (error=0)and(n>0) then flag:=true else flag:=false;
1:for i:=1 to length(s)do
if not(s[i] in simbols) then flag:=false;
2:for i:=1 to length(s) do
if not(s[i] in simbols) then flag:=false;
3:if (s='д')or(s='ю')or(s='в') then flag:=true else flag:=false;
4:if (s='х')or(s='п')or(s='и') then flag:=true else flag:=false;
5:if (error=0)and(n>0) then flag:=true else flag:=false;
6:if (error=0)and(n>0)and(n<=12) then flag:=true else flag:=false;
end;
until flag;
proverka:=s;
end;
{of proverka}
procedure open_file;
begin
{$I-}
assign(f,'rgz_2.dat');
reset(f);
if ioresult=2 then
begin
assign(f,'rgz_2.dat');
rewrite(f);
end;
{$I+}
end;
{of open_file}
procedure ramka(nomer:integer);
var
s:string;
begin
textbackground(brown);
window(1,1,80,50);
clrscr;
if nomer=1 then
begin
textcolor(4);
s:='Вверх/вниз-выбор записи';
gotoxy(40-length(s) div 2,43);
writeln(s);
s:='Нажмите ENTER, чтобы изменить запись';
gotoxy(40-length(s) div 2,45);
writeln(s);
s:='ESC-выход';
gotoxy(40-length(s) div 2,47);
writeln(s);
textcolor(yellow);
end;
textbackground(black);
window(x10,y10,x20,y20);
clrscr;
window(x10+1,y10+1,x20-1,y20-1);
clrscr;
end;
procedure vivod(file_p:integer);
var
i:integer;
w:dog;
begin
window(x10+1,y10+1,x20-1,y20-1);
clrscr;
seek(f,file_p);
for i:=1 to y20-y10-2 do
begin
if eof(f) then break;
read(f,w);
gotoxy(1,i);
writeln(w.naz);
gotoxy(10,i);
writeln(w.fio);
gotoxy(20,i);
writeln(w.vozr);
gotoxy(30,i);
writeln(w.tem);
gotoxy(40,i);
writeln(w.ter);
gotoxy(50,i);
writeln(w.mes);
end;
end;
{of vivod}
procedure dop_file(file_p:integer);
var
n,error:integer;
w1:dog;
begin
w.fio:=proverka(1);
w.naz:=proverka(2);
w.vozr:=proverka(3);
w.tem:=proverka(4);
val(proverka(5),n,error);
w.ter:=n;
val(proverka(6),n,error);
w.mes:=n;
seek(f,file_p);
write(f,w);
end;
{of dop_file}
procedure out_file;
var
p,file_p,file_p_0:integer;
begin
open_file;
ramka(1);
if filesize(f)<=y20-y10 then
begin
file_p:=filesize(f);
p:=file_p;
end
else
begin
file_p:=filesize(f)-(y20-y10-2);
p:=y20-y10-1;
end;
vivod(file_p);
file_p:=filesize(f);
gotoxy(1,p);
repeat
k:=readkey;
file_p_0:=file_p;
case k of
#32:menu(2,1);
#13:begin
dop_file(file_p);
out_file;
end;
#72:begin
if p>1 then p:=p-1;
if file_p>0 then file_p:=file_p-1;
if (p=1)and(file_p<>file_p_0) then vivod(file_p);
gotoxy(1,p);
end;
#80:begin
if (p<(y20-y10-1))and(p<filesize(f)) then p:=p+1;
if file_p<filesize(f) then file_p:=file_p+1;
if (p>=(y20-y10-1))and(file_p<>file_p_0) then vivod(file_p-(y20-y10-2));
gotoxy(1,p);
end;
#27:halt;
end;
until k=#27;
end;
{of out_file}
procedure new_file;
begin
assign(f,'rgz_2.dat');
rewrite(f);
close(f);
menu(2,2);
end;
{of new_file}
begin
write_menu(nomer_menu);
punkt:=punkt0;
repeat
k:=readkey;
write_punkt(yellow,punkt);
case k of
#72:if punkt=1 then punkt:=kol_punktov[nomer_menu]
else punkt:=punkt-1;
#80:if punkt=kol_punktov[nomer_menu] then punkt:=1
else punkt:=punkt+1;
#13:case nomer_menu of
1:case punkt of
1:menu(2,1);
2:menu(3,1);
3:halt;
end;
2:case punkt of
1:out_file;
2:new_file;
3:begin
open_file;
dop_file(filesize(f));
close(f);
out_file;
end;
4:menu(1,1);
end;
3:case punkt of
1:spis_grup;
2:stoim;
3:obem;
4:grafik;
5:krug;
6:stolbik;
7:menu(1,2);
end;
end;
end;
write_punkt(red,punkt);
until k=#13;
end;
{of menu}
begin
textmode(C80 + Font8x8);
menu(1,1);
end.
 читаем правила насчет больших текстов программ. данную задачу можно было в отдельный топ спросить, ибо не типовая задача. |
Всего записей: 11 | Зарегистр. 16-04-2006 | Отправлено: 17:46 18-04-2006 | Исправлено: ShIvADeSt, 02:08 19-04-2006 |
|
