IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Таблица, Расширение полей ввода и скроллинг записей
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Написал программу. Не получается выполнить следующее:

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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Может быть, кто-нибудь сможет помочь?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Понимаешь, в чем дело... Эту программу будет наверное проще написать заново, чем продираться сквозь тонны лишнего кода, и пытаться что-то поменять... Если тебе не очень срочно - и, самое главное, ты будешь принимать активное участие в написании (мне оно не нужно, выкладывать для тебя готовый код на блюдечке я не собираюсь, могу ПОМОЧЬ в понимании и написании программы) - пожалуйста...
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 26.10.2020 3:43
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name