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

> Перевести с Turbo на Pascal ABC, подскажите в каих местах исправить чтоб все также работало, пожалуйстт
Глеб
сообщение 11.05.2008 12:08
Сообщение #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(c);
	   writeln;
     until (c='N') or (c='n');
     close(f);
end;

procedure create;
var c:char;
begin
     clrscr;
     write('Все данные старой базы данных будут уничтожены. Продолжить (Yes/No)? ');
     readln(c);
     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(c);
	  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(c);
	  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(c);
     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

 

- Текстовая версия 29.07.2025 16:49
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"