Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль) > Pascal ABC
Войти
Регистрация
Восстановить пароль
Правила Карта Блоги Социальные группы Поиск Сообщения за день  
 
Рейтинг 4.73/11: Рейтинг темы: голосов - 11, средняя оценка - 4.73
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 18
1

Переделайте программу из Turbo Pascal в PascalABC

27.01.2013, 02:59. Просмотров 1982. Ответов 11
Метки нет (Все метки)
ПРОГРАММА:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

uses crt,TBL,graph; {подключение модулей}
 
function PrintNumbers(const yk: PInString):string;
var
temp: PInString; {буферная переменная для работы со стеком}
s,byf:string; {переменные для генерации строки}
n:word;
begin
temp:=yk; {копируем указатель на «голову» стека строк}
byf:=''; {обнуляем буферную переменную}
while temp<>nil do {выполняем до тех пор, пока стек не кончится}
begin
n:=temp^.number; {запоминаем номер строки}
temp:=temp^.next; {переход к след. Элементу стека}
s:=''; {обнуляем буферную переменную}
str (n,s); {переводим номер строки из word в string}
byf:=byf+s+' '; {«складываем» номера строк}
end;
PrintNumbers:=byf; {присваиваем значение процедуре}
end;
 
procedure PrintWords (const yk: PString);
var temp: PString;
strok,nom:word;
slov:string;
gm,gd:integer; {переменные для инициализации графики}
begin
temp:= yk; {копируем указатель на голову стека}
nom:=1; {счётчик строк, требуется при построение таблицы}
gm:=2; {инициализация графики }
gd:=VGA;
initGraph (gd,gm,'');
while temp<> nil do {выполняем до тех пор, пока стек не кончится}
begin
Table(temp^.st,nom,PrintNumbers(temp^.col)); {строим таблицу}
temp:=temp^.next; {переходим к след. Элементу стека}
end;
readkey; {ждём нажатия клавиши перед закрытием}
closeGraph; {закрываем графику}
end;
 
 
procedure AddNumber(var yk: PInString; n: word);
var temp: PInString;
begin
temp:=yk; {передаем указатель на голову стека }
while temp <> nil do {выполняем до тех пор, пока стек не кончится}
begin
if temp^.number = n then {если такой номер строки встречается в стеке , то выходим}
Exit;
temp:=temp^.next; {переходим к след. Элементу стека}
end;
new(temp); {если строка не обнаружена в стеке , заносим её}
temp^.next:=yk;
yk:=temp;
yk^.number:=n;
end;
 
procedure AddWord(var yk: PString; s: string; n: word);
var temp: PString;
begin
temp:=yk;
while temp<>nil do{выполняем до тех пор, пока стек не кончится}
begin
if s = temp^.st then {если слово уже есть, то добавляем номер строки в стек}
begin
AddNumber(temp^.col,n);
Exit;
end;
temp:=temp^.next; {переходим к след. Элементу стека}
end;
new(temp); {Если слово встречается впервые, добавляем его}
temp^.next:=yk;
yk:=temp;
yk^.st:=s;
yk^.col:=Nil;
AddNumber(yk^.col,n); {добавляем номер строки}
end;
 
 
var
f: text;
FileName: string;
ch,a: char;
MyWord: string;
line: word;
 
procedure Schet (fileName:string);
begin
ClrScr;
assign(f,fileName); {открытие файла}
reset(f);
myWord:=''; {обнуление переменной, в которой будут формироваться слова}
Line:=1;
while not Eof(f) do {выполнять пока не конец файла}
begin
if ch = #13 then inc(line); {если возврат каретки, то увеличиваем номер строки }
read(f,Ch); {читаем символ}
if ((not(ch in[',','.',' ',';'])) and (ch <> #13 ) and (ch <> #10))then myWord:=myWord+ch {проверяем символ.Если он – буква , то добавляем в буферно слово }
else {иначе считаем слово завершённым и если оно не пусто, вызываем процедуру добавления в стек}
begin
if (myWord <> '') then
AddWord(head,myWord,line); {добавление слова в стек}
while ((ch=' ') and (ch = #13) and (ch = #10) ) do read(f,ch); {пропуск символов, не являющихся буквами}
myWord:=''; {обнуление переменной, в которой будут формироваться слова}
end;
end;
PrintWords(head); {печать таблицы}
readKey;
close(f);
end;
 
procedure vivod(fileName:string);
var
st:string;{переменная, в которую будут заноситься строки из файла}
begin
clrscr;
assign(f,faleName);{присваиваем переменной f имя}
resert(f);{открытие файла}
while not(eof(f)) do{до тех пор, пока не конец файла}
begin
readln(f,st);{читать из файла}
writeln(st);{выводить на экран}
end;
readln;
close(f);{закрытие файла}
end;
 
begin
clrscr;
write('name of file:');
readln(fileName);{запись пути к файлу}
a:='';{символ для управления программой}
while a<>'q' do{выполнять пока символ не равен'q'}
begin
clrscr;
{******************вывод меню}
writeln('1-vivod');
writeln('2-prohod po strokam');
writeln('q-vihod');
a:=readkey;{чтение запроса, что делать дальше}
case a of{выбор, что делать}
'1':vivod(fileName);
'2':Schet(fileName);
end;
end;
end.{конец программы}

МОДУЛЬ:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

unit TBL;
interface {глобальные описание}
uses graphABC,crt;
type PString = ^Tstring;
PInString = ^TInString;
 
Tstring = record
st: string;
col: PInString;
next: PString;
end;
 
TInString = record
number: word;
next: PInString;
end;
 
const head: PString = nil;
procedure Table (sl:string;nom:word;s:string);
 
implementation {локальные описания}
 
procedure Table (sl:string;nom:word;s:string);
begin
if nom=1 then {Если выводится 1я строка таблицы, то создается «шапка» }
begin
line (320,1,320,15);
line (1,1,639,1);
line (1,15,639,15);
outtextxy (5,3,'slovo');
outtextxy (325,3,'stroki');
end;
inc(nom); {счётчик номеров строк в таблице. Используется при выводе и построение «шапки» }
line (320,nom*15,3
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 27.01.2013, 02:59
Ответы с готовыми решениями:

Переделайте, пожалуйста, программу из Turbo pascal в ABC pascal
Помогите, пожалуйста, перевести из PASCAL TURBO в PASCAL ABC Program ProgInt; Uses Crt,...

Как переписать программу, написанную в PascalABC, для работы в Turbo Pascal, и наоборот?
работа с модулем Graph.

Перевод из turbo Pascal в PascalABC
Здравствуйте. Я не очень силен в программировании и перевод занимает долгое время. Очень сильно...

В чем отличия Turbo Pascal от PascalABC
хотелось бы знать какие между ними различия)

11
Модератор
62244 / 46531 / 32078
Регистрация: 18.05.2008
Сообщений: 112,486
27.01.2013, 09:11 2
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

А модуль не весь, нет конца.

Добавлено через 16 минут
И нужен исходный файл для тестирования.

Добавлено через 19 минут
Переделал то что опубликовано.
Модуль
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

unit TBL;
interface {глобальные описание}
uses graphABC,crt;
type PString = ^Tstring;
     PInString = ^TInString;
     Tstring = record
               st: string;
               col: PInString;
               next: PString;
               end;
     TInString = record
                 number: word;
                 next: PInString;
                 end;
 
//var head:PString;
 
procedure Table (sl:string;nom:word;s:string);
 
implementation {локальные описания}
 
procedure Table (sl:string;nom:word;s:string);
begin
hidecursor;
if nom=1 then {Если выводится 1я строка таблицы, то создается «шапка» }
 begin
  line (320,1,320,25);
  line (1,1,639,1);
  line (1,25,639,25);
  textout (5,3,'слово');
  textout (325,3,'строки');
 end;
inc(nom); {счётчик номеров строк в таблице. Используется при выводе и построение «шапки» }
line (320,nom*25,3,nom*25)
end;
end.
Программа
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

uses crt,TBL; {подключение модулей}
 
function PrintNumbers(const yk: PInString):string;
var
temp: PInString; {буферная переменная для работы со стеком}
s,byf:string; {переменные для генерации строки}
n:word;
begin
temp:=yk; {копируем указатель на «голову» стека строк}
byf:=''; {обнуляем буферную переменную}
while temp<>nil do {выполняем до тех пор, пока стек не кончится}
begin
n:=temp^.number; {запоминаем номер строки}
temp:=temp^.next; {переход к след. Элементу стека}
s:=''; {обнуляем буферную переменную}
str (n,s); {переводим номер строки из word в string}
byf:=byf+s+' '; {«складываем» номера строк}
end;
PrintNumbers:=byf; {присваиваем значение функции}
end;
 
procedure PrintWords (const yk: PString);
var temp: PString;
strok,nom:word;
slov:string;
begin
temp:= yk; {копируем указатель на голову стека}
nom:=1; {счётчик строк, требуется при построение таблицы}
while temp<> nil do {выполняем до тех пор, пока стек не кончится}
begin
Table(temp^.st,nom,PrintNumbers(temp^.col)); {строим таблицу}
temp:=temp^.next; {переходим к след. Элементу стека}
end;
readkey; {ждём нажатия клавиши перед закрытием}
end;
 
 
procedure AddNumber(var yk: PInString; n: word);
var temp: PInString;
begin
temp:=yk; {передаем указатель на голову стека }
while temp <> nil do {выполняем до тех пор, пока стек не кончится}
begin
if temp^.number = n then {если такой номер строки встречается в стеке , то выходим}
Exit;
temp:=temp^.next; {переходим к след. Элементу стека}
end;
new(temp); {если строка не обнаружена в стеке , заносим её}
temp^.next:=yk;
yk:=temp;
yk^.number:=n;
end;
 
procedure AddWord(var yk: PString; s: string; n: word);
var temp: PString;
begin
temp:=yk;
while temp<>nil do{выполняем до тех пор, пока стек не кончится}
begin
if s = temp^.st then {если слово уже есть, то добавляем номер строки в стек}
begin
AddNumber(temp^.col,n);
Exit;
end;
temp:=temp^.next; {переходим к след. Элементу стека}
end;
new(temp); {Если слово встречается впервые, добавляем его}
temp^.next:=yk;
yk:=temp;
yk^.st:=s;
yk^.col:=Nil;
AddNumber(yk^.col,n); {добавляем номер строки}
end;
 
 
var
f: text;
FileName: string;
ch,a: char;
MyWord: string;
line: word;
head:Pstring;
procedure Schet (fileName:string);
begin
ClrScr;
assign(f,fileName); {открытие файла}
reset(f);
myWord:=''; {обнуление переменной, в которой будут формироваться слова}
Line:=1;
while not Eof(f) do {выполнять пока не конец файла}
begin
if ch = #13 then inc(line); {если возврат каретки, то увеличиваем номер строки }
read(f,Ch); {читаем символ}
if ((not(ch in[',','.',' ',';'])) and (ch <> #13 ) and (ch <> #10))then myWord:=myWord+ch {проверяем символ.Если он – буква , то добавляем в буферно слово }
else {иначе считаем слово завершённым и если оно не пусто, вызываем процедуру добавления в стек}
begin
if (myWord <> '') then
AddWord(head,myWord,line); {добавление слова в стек}
while ((ch=' ') and (ch = #13) and (ch = #10) ) do read(f,ch); {пропуск символов, не являющихся буквами}
myWord:=''; {обнуление переменной, в которой будут формироваться слова}
end;
end;
PrintWords(head); {печать таблицы}
readKey;
close(f);
end;
 
procedure vivod(fileName:string);
var
st:string;{переменная, в которую будут заноситься строки из файла}
begin
clrscr;
assign(f,fileName);{присваиваем переменной f имя}
reset(f);{открытие файла}
while not(eof(f)) do{до тех пор, пока не конец файла}
begin
readln(f,st);{читать из файла}
writeln(st);{выводить на экран}
end;
readln;
close(f);{закрытие файла}
end;
 
begin
clrscr;
write('name of file:');
readln(fileName);{запись пути к файлу}
a:=#0;{символ для управления программой}
while a<>'q' do{выполнять пока символ не равен'q'}
begin
clrscr;
{******************вывод меню}
writeln('1-vivod');
writeln('2-prohod po strokam');
writeln('q-vihod');
a:=readkey;{чтение запроса, что делать дальше}
case a of{выбор, что делать}
'1':vivod(fileName);
'2':Schet(fileName);
'q':exit;
end;
end;
end.{конец программы}
1
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 18
27.01.2013, 16:37  [ТС] 3
Большое спасибо! Только у меня вопрос. Почему он выдает ошибку ввода/вывода 2: не удается найти указанный файл (Program1.pas, строка 114)?
0
Pascal, Delphi, C++
215 / 128 / 91
Регистрация: 01.12.2012
Сообщений: 628
27.01.2013, 16:45 4
Цитата Сообщение от Елена04 Посмотреть сообщение
не удается найти указанный файл (Program1.pas, строка 114)?
значит файл не был создан

Добавлено через 2 минуты
ресет открывает для чтения а перед этим должен быть реврайт чтобы открыть для записи ну и сама запись
1
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 18
27.01.2013, 16:48  [ТС] 5
Он создан и сохранен там же, где и программа. Как его нужно назвать или что вообще сделать, чтобы работало?
0
Модератор
62244 / 46531 / 32078
Регистрация: 18.05.2008
Сообщений: 112,486
27.01.2013, 17:33 6
Я создавал текстовый файл 11.txt, когда программа запрашивала имя файла, я вводил 11.txt и все работало.
1
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 18
27.01.2013, 17:52  [ТС] 7
Всё, разобралась, получилось)
0
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 18
28.01.2013, 01:47  [ТС] 8
Еще один вопрос: при выводе на экран, когда я ввожу название файла, потом список выводится:1, 2 и q. Так вот когда я 2 нажимаю, по-моему какая-то ерунда получается, какая-то недоделанная таблица( Как это исправить? Это косяк в коде программы или это я не так что-то делаю?
0
Миниатюры
Переделайте программу из Turbo Pascal в PascalABC  
Модератор
62244 / 46531 / 32078
Регистрация: 18.05.2008
Сообщений: 112,486
28.01.2013, 08:14 9
Цитата Сообщение от Елена04 Посмотреть сообщение
Это косяк в коде программы или это я не так что-то делаю?
Я же писал Вам что текст модуля не полный и я исправил только то что было.
0
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 18
28.01.2013, 10:02  [ТС] 10
Можете доделать, пожалуйста:
МОДУЛЬ:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

unit TBL;
interface {глобальные описание}
uses graphABC,crt;
type PString = ^Tstring;
PInString = ^TInString;
 
Tstring = record
st: string;
col: PInString;
next: PString;
end;
 
TInString = record
number: word;
next: PInString;
end;
 
const head: PString = nil;
procedure Table (sl:string;nom:word;s:string);
 
implementation {локальные описания}
 
procedure Table (sl:string;nom:word;s:string);
begin
if nom=1 then {Если выводится 1я строка таблицы, то создается «шапка» }
begin
line (320,1,320,15);
line (1,1,639,1);
line (1,15,639,15);
outtextxy (5,3,'slovo');
outtextxy (325,3,'stroki');
end;
inc(nom); {счётчик номеров строк в таблице. Используется при выводе и построение «шапки» }
line (320,nom*15,320,nom*15+15); {чертёж строки. для определения Y используется счётчик номеров строк в таблице (nom) }
line (5,nom*15,634,nom*15);
line (5,(nom+1)*15,5,nom*15);
line (634,(nom+1)*15,634,nom*15);
line (5,nom*15+15,634,nom*15+15);
outtextxy (9,nom*15+4,sl); {вывод слова}
outtextxy (325,nom*15+4,s); {вывод номеров строк}
end;
end.
0
Модератор
62244 / 46531 / 32078
Регистрация: 18.05.2008
Сообщений: 112,486
28.01.2013, 12:22 11
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Я доделал модуль до конца для Паскаля АВС.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

unit TBL;
interface {глобальные описание}
uses graphABC,crt;
type PString = ^Tstring;
     PInString = ^TInString;
     Tstring = record
               st: string;
               col: PInString;
               next: PString;
               end;
     TInString = record
                 number: word;
                 next: PInString;
                 end;
 
//var head:PString;
 
procedure Table (sl:string;nom:word;s:string);
 
implementation {локальные описания}
 
procedure Table (sl:string;nom:word;s:string);
begin
hidecursor;
if nom=1 then {Если выводится 1я строка таблицы, то создается «шапка» }
 begin
  line (320,1,320,25);
  line (1,1,639,1);
  line (1,25,639,25);
  textout (5,3,'слово');
  textout (325,3,'строки');
 end;
inc(nom); {счётчик номеров строк в таблице. Используется при выводе и построение «шапки» }
line (320,nom*25,3,nom*25);
line (5,nom*25,634,nom*25);
line (5,(nom+1)*25,5,nom*25);
line (634,(nom+1)*25,634,nom*25);
line (5,nom*25+25,634,nom*25+25);
textout (9,nom*25+4,sl); {вывод слова}
textout (325,nom*25+4,s); {вывод номеров строк}
end;
end.
Но все равно программа не работает нормально.
Она и в первом варианте в Турбо Паскале неверно работает даже после исправления всех синтаксических ошибок, также создает 1 строку в графике при выборе прохода по строкам.
Поэтому программу нужно переделывать. Я пас, поскольку в динамике плохо соображаю.

Добавлено через 1 минуту
Кстати в АВС называйте файл без символов 1,2,q
1
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 18
28.01.2013, 21:32  [ТС] 12
А Вы не могли бы еще один модуль составить?
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 28.01.2013, 21:32

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Переделать код программы из Turbo Pascal в PascalABC
Ребят может кто-нибудь помочь пожалуйста из PascalABC.NET в PascalABC переделать код программы и...

График температур. Подправить код из turbo (не знаю где писать в PascalABC или PascalABC.net)
На Pascal ABC не запускается(( uses crt,graph; const n=31; {массив - константа, можно...

Turbo Pascal, Pascal ABC, Free Pascal, PascalABC.NET - в чем разница?
Всем привет, решил изучать Паскаль, но на форуме увидел 4 его версии - Turbo Pascal, Pascal ABC,...

Указатели в Turbo Pascal и PascalABC
Вопрос: почему в Turbo Pascal тактая конструкция const TAB = ^I; begin end. работает, а...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Реклама - Обратная связь
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.