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

 
 Ответить  Открыть новую тему 
> Перевести с Turbo на Pascal ABC, подскажите в каих местах исправить чтоб все также работало, пожалуйстт
сообщение
Сообщение #1





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

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


Вот программа написанная на Turbo Pascalе, что то не так заменяю и в ABC не открывает меню БД а сразу приступает к ее созданию и только и это делает... помогите, пожалуйста!

Program repair1;
Uses CRT;

Type
Tdata = record
k : word;
nd,td,ta : string[15];
zi : string[10];
c,p : integer;
end;
datfile = file of Tdata;

Var r: Tdata;
f: datfile;
q,k: byte;

procedure tit_list;
begin
clrscr;
GotoXY (14,2);
write ('Волгоградский государственный технический университет');;
GotoXY (24,4);
write ('Кафедра "ВЫЧИСЛИТЕЛЬНАЯ ТЕХНИКА"');
GotoXY (32,8);
write ('Семестровая работа');
GotoXY (45,16);
write ('Выполнил студент группы: АУ-120');
GotoXY (45,17);
write ('Иванов И.И.');
GotoXY (45,19);
write ('Проверил:');
GotoXY (45,20);
write ('Сидоров С.С.');
GotoXY (33,24);
write ('Волгоград 2008');
readkey;
end;

procedure color(s,p:byte);
begin
if s=p then
begin
TextBackGround(white);
TextColor(black);
end
else
begin
TextBackGround(black);
TextColor(white);
end;
end;

procedure InpDate;
begin
write('Код детали: ');
readln(r.k);
write('Наименование детали: ');
readln(r.nd);
write('Тип детали: ');
readln(r.td);
write('Тип авто: ');
readln(r.ta);
write('Завод изготовитель: ');
readln(r.zi);
write('Количество: ');
readln(r.c);
write('Цена за единицу: ');
readln(r.p);
end;

Procedure OutDate;
begin
gotoxy(2,whereY);
write(r.k);
gotoxy(6,whereY);
write('|',r.nd);
gotoxy(23,whereY);
write('|',r.td);
gotoxy(40,whereY);
write('|',r.ta);
gotoxy(56,whereY);
write('|',r.zi);
gotoxy(69,whereY);
write('|',r.c);
gotoxy(73,whereY);
writeln('|',r.p);
end;

procedure add;
var c:char;
begin
clrscr;
assign(f,'dates.db');
reset(f);
seek(f,filesize(f));
repeat
InpDate;
write(f,r);
writeln;
write('Добавить еще запись (Yes/No)? ');
readln©;
writeln;
until (c='N') or (c='n');
close(f);
end;

procedure create;
var c:char;
begin
clrscr;
write('Все данные старой базы данных будут уничтожены. Продолжить (Yes/No)? ');
readln©;
if (c='Y') or (c='y') then
begin
assign(f,'dates.db');
rewrite(f);
close(f);
add;
end;

end;

procedure write_title;
var i:byte;
begin
gotoxy(2,1);
write(' КОД');
gotoxy(6,1);
write('| НАИМЕН ДЕТ');
gotoxy(23,1);
write('| ТИП ДЕТ');
gotoxy(40,1);
write('| ТИП АВТО');
gotoxy(56,1);
writeln('|ИЗГОТОВИТЕЛЬ|КОЛ|ЦЕНА');
for i:=1 to 80 do write('-');
end;

procedure edit;
var c:char;
begin
clrscr;
assign(f,'dates.db');
reset(f);
write_title;
while not eof(f) do
begin
read(f,r);
OutDate;
write('Корректировать (Yes/No)?');
readln©;
if (c='Y') or (c='y') then
begin
InpDate;
seek(f,filepos(f)-1);
write(f,r);
end;
writeln;
end;
close(f);
end;

procedure delete;
var i:integer;
c:char;
begin
clrscr;
assign(f,'dates.db');
reset(f);
write_title;
i:=0;
while not eof(f) do
begin
read(f,r);
OutDate;
write('Удалить (Yes/No)?');
readln©;
if (c='Y') or (c='y') then
begin
i:=filepos(f)-1;
if i<>(filesize(f)-1) then
while not eof(f) do
begin
read(f,r);
seek(f,filepos(f)-2);
write(f,r);
seek(f,filepos(f)+1);
end;
seek(f,filesize(f)-1);
truncate(f);
seek(f,i);
end;
end;
close(f);
end;

procedure print;
var i:byte;
begin
assign(f,'dates.db');
reset(f);
clrscr;
write_title;
while not eof(f) do
begin
read(f,r);
OutDate;
end;
for i:=1 to 80 do write('-');
readkey;
close(f);
end;

procedure zapros;
var rt,rm:Tdata;
k,j:integer;
c:byte;
s:boolean;
begin
clrscr;
assign(f,'dates.db');
reset(f);
writeln('1 - список деталей по коду');
writeln('2 - по типу авто список деталей');
writeln('3 - однотипные детали, отсортированные по цене');
writeln;
readln©;
case c of
1: begin
clrscr;
write('kod :');
readln(rt.k);
clrscr;
write_title;
s:=false;
while not eof(f) do
begin
read(f,r);
if r.k=rt.k then
begin
OutDate;
s:=true;
end;
end;
if s=false then write('not found');
readkey
end;
2: begin
clrscr;
write('auto: ');
readln(rt.ta);
clrscr;
write_title;
s:=false;
while not eof(f) do
begin
read(f,r);
if r.ta=rt.ta then
begin
OutDate;
s:=true;
end;
end;
if s=false then write('not found');
readkey
end;
3: begin
reset(f);
while not eof(f) do
begin
read(f,r);
rm:=r;
j:=filepos(f);
k:=filepos(f);
while not eof(f) do
begin
read(f,r);
if r.p<rm.p then
begin
rm:=r;
k:=filepos(f);
end;
end;
seek(f,j-1);
read(f,r);
seek(f,j-1);
write(f,rm);
seek(f,k-1);
write(f,r);
seek(f,j);
end;
clrscr;
write('tip det: ');
readln(rt.td);
clrscr;
write_title;
s:=false;
while not eof(f) do
begin
read(f,r);
if r.td=rt.td then
begin
OutDate;
s:=true;
end;
end;
if s=false then write('not found');
readkey
end;
end;
close(f);
end;

procedure run;
begin
case q of
1: create;
2: print;
3: add;
4: delete;
5: edit;
6: zapros;
7: halt;
end;
end;

Begin
tit_list;
q:=1;
Repeat
clrscr;
color(1,q);
gotoxy(27,10);
Write('Создание БД ');
color(2,q);
gotoxy(27,11);
Write('Вывод БД ');
color(3,q);
gotoxy(27,12);
Write('Добавление записей в БД ');
color(4,q);
gotoxy(27,13);
Write('Удаление записей из БД ');
color(5,q);
gotoxy(27,14);
Write('Корректировка записей в БД');
color(6,q);
gotoxy(27,15);
Write('Печать сведений по запросу');
color(7,q);
gotoxy(27,16);
Write('Выход ');
color(1,2);
gotoxy(1,25);
write(q);
k:=ord(readkey);
if k=0 then k:=ord(readkey);
case k of
72: if q<>1 then q:=q-1 else q:=7;
80: if q<>7 then q:=q+1 else q:=1;
75: q:=1;
77: q:=7;
13: run;
end;
until k=27;
end.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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