Правила форума
Прочтите прежде чем задавать вопрос!
1. Увеличить поле ввода "Наименование" до 255 символов. При выводе запись должна либо разбиваться на несколько строк для того, чтобы в таблице уместиться в графе "Наименование", либо прокручиваться по горизонтали при наведении курсора нажатии клавиш "влево"/"вправо".
2. Отладить функцию прокрутки записей в таблице.
3. Отладить функцию подсчёта количества деталей на стеллаже.
4. Запретить ввод пустого значения в поле "Наименование" при добавлении записи.
5. Ввести запрос подтверждения "Вы уверены?(y/n)" при выходе из программы, как выполнено в функции очистки файла. Y - выход из программы, N - возврат в меню.
6. Позволить ввод дробных значений в поле "Стоимость".
Вот, собственно, сама программа:
program details;Буду благодарен помощи.
uses crt;
type
det=record
name:string;
num,snum,price:longint;
end;
var
f:file of det;
i,n,nn,j,k,b,c,q,e,ii,jj,x,y:longint;
m:longint;
rec:det;
m_name: array [1..100] of string;
m_num,m_snum,m_price: array [1..100] of longint;
a: array [1..20] of det;
key:char;
chk:byte;
bb:array[1..2] of string;
{---Меню(начало)---}
procedure Menu;
begin
clrscr;
writeln(' База данных');
write(#218);
for i:=1 to 30 do write(#196);
write(#194);
for i:=1 to 15 do write(#196);
write(#194);
for i:=1 to 15 do write(#196);
write(#194);
for i:=1 to 15 do write(#196);
write(#191);
write(#179,' Наименование детали ',#179,
' Номер детали ',#179,' Номер стеллажа',#179,' Стоимость ',#179);
write(#195);
for i:=1 to 30 do write(#196);
write(#197);
for i:=1 to 15 do write(#196);
write(#197);
for i:=1 to 15 do write(#196);
write(#197);
for i:=1 to 15 do write(#196);
write(#180);
write(#192);
for i:=1 to 30 do write(#196);
write(#193);
for i:=1 to 15 do write(#196);
write(#193);
for i:=1 to 15 do write(#196);
write(#193);
for i:=1 to 15 do write(#196);
write(#217);
writeln('1 - Вывод базы данных на экран');
writeln('2 - Добавление записи');
writeln('3 - Сортировка по наименованию деталей');
writeln('4 - Подсчет количества деталей на стеллаже');
writeln('5 - Очистка файла');
writeln('Esc - Выход');
{---Меню(конец)---}
{---Шапка(начало)---}
end;
procedure Head;
begin
writeln(' База данных');
write(#218);
for i:=1 to 30 do write(#196);
write(#194);
for i:=1 to 15 do write(#196);
write(#194);
for i:=1 to 15 do write(#196);
write(#194);
for i:=1 to 15 do write(#196);
write(#191);
write(#179,' Наименование детали ',#179,' Номер детали ',
#179,' Номер стеллажа',#179,' Стоимость ',#179);
write(#195);
for i:=1 to 30 do write(#196);
write(#197);
for i:=1 to 15 do write(#196);
write(#197);
for i:=1 to 15 do write(#196);
write(#197);
for i:=1 to 15 do write(#196);
write(#180);
{!!!!!!!!!!}for i:=1 to 43 do
write(#179,' ',#179,' ',
#179,' ',#179,' ',#179);
write(#192);
for i:=1 to 30 do write(#196);
write(#193);
for i:=1 to 15 do write(#196);
write(#193);
for i:=1 to 15 do write(#196);
write(#193);
for i:=1 to 15 do write(#196);
write(#217);
write('Нажмите F1 для выхода в меню');
end;
{---Шапка(конец)---}
{---Вывод_БД(начало)---}
procedure out;
begin
reset(f);
c:=0;
x:=1;
y:=4;
while not eof(f) do
begin
c:=c+1;
read(f,rec);
m_name[c]:=rec.name;
m_num[c]:=rec.num;
m_snum[c]:=rec.snum;
m_price[c]:=rec.price;
end;
if c<=43 then e:=c
else e:=c;
for i:=1 to e do
begin
y:=y+1;
gotoxy(x,y);
writeln(#179,m_name[i]:30,#179,m_num[i]:15,#179,m_snum[i]:15,#179,m_price[i]:15)
;
end;
e:=c;
q:=1;
y:=5;
key:=readkey;
repeat
case ord(readkey) of
80:
begin
q:=q+1;
if q>e then q:=e;
clrscr;
head;
for i:=(c-(c-1)) to c do
begin
y:=y+1;
gotoxy(x,y);
writeln(#179,m_name[i]:30,#179,m_num[i]:15,#179,m_snum[i]:15,#179,m_price[i]:15)
;
if y=47 then y:=y-1;
end;
end;
72:
begin
if y=5 then y:=y+1;
q:=q-1;
if q>e then q:=e;
if q<7 then q:=e;
clrscr;
head;
for i:=q downto q-(q-1) do
begin
y:=y-1;
gotoxy(x,y);
writeln(#179,m_name[i]:30,#179,m_num[i]:15,#179,m_snum[i]:15,#179,m_price[i]:15)
;
if y=5 then y:=y+1;
end;
end;
59:
begin
clrscr;
break;
end;
end;
until (key<>#0);
close(f);
end;
{---Вывод_БД(конец)---}
{---Добавление_записи(начало)---}
procedure add;
var
io:longint;
ms1:string[31];
ms2,ms3,ms4:string[10];
chk:char;
flag:boolean;
begin
{$I-}
reset(f);
writeln('Введите поля записи');
n:=filesize(f);
seek(f,n);
repeat
write('наименование : ');
settextbuf(input,ms1);
readln(rec.name);
flag:=false;
for i:=1 to length(rec.name) do
begin
if (rec.name[i]=' ') then flag:=true else flag:=false;
end;
until (length(rec.name)<>0) or (flag<>true);
{ chk:=ord[0]);
for jj:=1 to chk/13 do
for ii:=1+jj*13-13 to jj*13 do
bb[jj]:=bb[jj]+chr(ord(input[ii]));
}
repeat
clrscr;
write('Номер детали : ');
settextbuf(input,ms2);
readln(rec.num);
io:=ioresult;
until (io=0) and (rec.num>0);
repeat
clrscr;
write('Номер стеллажа : ');
settextbuf(input,ms3);
readln(rec.snum);
io:=ioresult;
until (io=0) and (rec.snum>0);
repeat
clrscr;
write('Стоимость : ');
settextbuf(input,ms4);
readln(rec.price);
io:=ioresult;
until (io=0) and (rec.price>0);
write(f,rec);
close(f);
end;
{---Добавление_записи(конец)---}
{---Сортировка(начало)---}
procedure Sort;
var
s:det;
i,j:integer;
begin
ClrScr;
reset(f);
i:=1;
while not eof(f) do
begin
read(f,a[i]);
i:=i+1;
end;
n:=i;
m:=1;
for i:=1 to n-1 do
for j:=i+1 to n-1 do
if(a[i].name>a[j].name)then
begin
s:=a[i];
a[i]:=a[j];
a[j]:=s;
end;
writeln('База данных отсортирована.');
writeln('Нажмите любую клавишу.');
readkey;
seek(f,0);
for j:=1 to n-1 do
write(f,a[j]);
close(f);
end;
{---Сортировка(конец)---}
{---Подсчет_деталей(начало)---}
procedure count(nn:integer);
var res:integer;
begin
reset(f);
i:=1;
while not eof(f) do
begin
read(f,a[i]);
i:=i+1;
end;
res:=0;
n:=i;
m:=1;
for i:=1 to n do
if a[i].snum=nn then
res:=res+1;
writeln('кол-во деталей на стелаже ',nn,' равно: ',res);
readkey;
close(f);
end;
{---Подсчет_деталей(конец)---}
{---Очистка_файла(начало)---}
procedure tranc;
var
yn:integer;
begin
writeln('Очистить файл(y/n)?');
yn:=0;
yn:=ord(readkey);
if (yn=89) or (yn=121) then
begin
reset(f);
truncate(f);
close(f);
writeln('Файл очищен');
end;
if (yn=78) or (yn=110) then writeln('Очистка файла отменена');
readkey;
end;
{---Очистка_файла(конец)---}
{---Выход(начало)---
procedure quit;
var
yn:integer;
begin
writeln('Выйти из программы(y/n)?');
yn:=0;
yn:=ord(readkey);
if (yn=89) or (yn=121) then halt;
if (yn=78) or (yn=110) then exit;
end;
---Выход(конец)---}
{---------------------------------}
begin
clrscr;
assign(f,'f.dat');
rewrite(f);
truncate(f);
clrscr;
i:=0;
Menu;
b:=0;
while b<>27 do
begin
b:=ord(readkey);
if b=49 then begin
clrscr;
Head;
out;
menu;
end;
if b=50 then begin
clrscr;
add;
menu;
end;
if b=51 then begin
clrscr;
Sort;
menu;
end;
if b=52 then begin
clrscr;
writeln('Введите номер стелажа:');
repeat
read(nn);
until ioresult=0;
count(nn);
menu;
end;
if b=53 then begin
clrscr;
tranc;
menu;
end;
{if b=27 then begin
clrscr;
quit;
menu;
end;}
end;
end.
Сообщение отредактировано: volvo -
