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

@Елена04 · Регистрация: 27.05.2012

Author24 — интернет-сервис помощи студентам

ПРОГРАММА:

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

@Puporev · 27.01.2013, 09:11

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

Добавлено через 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.{конец программы}

@Елена04 · 27.01.2013, 16:37 **[ТС]**

Большое спасибо! Только у меня вопрос. Почему он выдает ошибку ввода/вывода 2: не удается найти указанный файл (Program1.pas, строка 114)?

@Taftis · 27.01.2013, 16:45

Сообщение от Елена04

не удается найти указанный файл (Program1.pas, строка 114)?

значит файл не был создан

Добавлено через 2 минуты
ресет открывает для чтения а перед этим должен быть реврайт чтобы открыть для записи ну и сама запись

@Елена04 · 27.01.2013, 16:48 **[ТС]**

Он создан и сохранен там же, где и программа. Как его нужно назвать или что вообще сделать, чтобы работало?

@Puporev · 27.01.2013, 17:33

Я создавал текстовый файл 11.txt, когда программа запрашивала имя файла, я вводил 11.txt и все работало.

@Елена04 · 27.01.2013, 17:52 **[ТС]**

Всё, разобралась, получилось)

@Елена04 · 28.01.2013, 01:47 **[ТС]**

Еще один вопрос: при выводе на экран, когда я ввожу название файла, потом список выводится:1, 2 и q. Так вот когда я 2 нажимаю, по-моему какая-то ерунда получается, какая-то недоделанная таблица( Как это исправить? Это косяк в коде программы или это я не так что-то делаю?

@Puporev · 28.01.2013, 08:14

Сообщение от Елена04

Это косяк в коде программы или это я не так что-то делаю?

Я же писал Вам что текст модуля не полный и я исправил только то что было.

@Елена04 · 28.01.2013, 10:02 **[ТС]**

Можете доделать, пожалуйста:
МОДУЛЬ:

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.

@Puporev · 28.01.2013, 12:22

Я доделал модуль до конца для Паскаля АВС.

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

@Елена04 · 28.01.2013, 21:32 **[ТС]**

А Вы не могли бы еще один модуль составить?

Новые блоги и статьи Все статьи Все блоги /
Исключения в Java: советы, примеры кода и многое другое Javaican 18.05.2025 Исключения — это объекты, созданные когда программа сталкивается с непредвиденной ситуацией: файл не найден, сетевое соединение разорвано, деление на ноль. . . Список можно продолжать до бесконечности. . . .	Как сделать SSO (Single Sign-On) в C# приложении stackOverflow 18.05.2025 SSO — это механизм, позволяющий пользователю пройти аутентификацию один раз и получить доступ к нескольким приложениям без повторного ввода учетных данных. Вы наверняка сталкивались с ним, когда. . .	Kubernetes с Apache Flink для обработки данных в реальном времени Mr. Docker 17.05.2025 Kubernetes — это целая философия управления распределёнными приложениями. В отличие от "примитивных" решений вроде Docker Swarm, K8s (как его ласково называют в тусовке DevOps-инженеров) предлагает. . .	Использование декораторов в Python py-thonny 17.05.2025 Если вы когда-нибудь задумывались о том, как красиво расширить функциональность кода без лишней возни и дублирования, декораторы в Python — та самая волшебная палочка, которую вы искали. По сути, это. . .	Реализация многопоточных сетевых серверов на Python py-thonny 16.05.2025 Когда сталкиваешься с необходимостью писать высоконагруженные сетевые сервисы, выбор технологии имеет критическое значение. Python, со своей элегантностью и высоким уровнем абстракции, может. . .
C# и IoT: разработка Edge приложений с .NET и Azure IoT UnmanagedCoder 16.05.2025 Мир меняется прямо на наших глазах, и интернет вещей (IoT) — один из главных катализаторов этих перемен. Если всего десять лет назад концепция "умных" устройств вызывала скептические улыбки, то. . .	Гибридные квантово-классические вычисления: Примеры оптимизации EggHead 16.05.2025 Гибридные квантово-классические вычисления — это настоящий прорыв в подходах к решению сложнейших вычислительных задач. Представьте себе союз двух разных миров: классические компьютеры, с их. . .	Использование вебсокетов в приложениях Java с Netty Javaican 16.05.2025 HTTP, краеугольный камень интернета, изначально был спроектирован для передачи гипертекста с минимальной интерактивностью. Его главный недостаток в контексте современных приложений — это. . .	Реализация операторов Kubernetes Mr. Docker 16.05.2025 Концепция операторов Kubernetes зародилась в недрах компании CoreOS (позже купленной Red Hat), когда команда инженеров искала способ автоматизировать управление распределёнными базами данных в. . .	Отражение в C# и динамическое управление типами stackOverflow 16.05.2025 Reflection API в . NET — это набор классов и интерфейсов в пространстве имён System. Reflection, который позволяет исследовать и манипулировать типами, методами, свойствами и другими элементами. . .

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

Решение

Решение

@Елена04 0 / 0 / 0 Регистрация: 27.05.2012 Сообщений: 18
	27.01.2013, 16:37 [ТС]
	Большое спасибо! Только у меня вопрос. Почему он выдает ошибку ввода/вывода 2: не удается найти указанный файл (Program1.pas, строка 114)? 0

@Елена04 0 / 0 / 0 Регистрация: 27.05.2012 Сообщений: 18
	27.01.2013, 16:48 [ТС]
	Он создан и сохранен там же, где и программа. Как его нужно назвать или что вообще сделать, чтобы работало? 0

@Puporev Почетный модератор 64312 / 47609 / 32742 Регистрация: 18.05.2008 Сообщений: 115,181
	27.01.2013, 17:33
	Я создавал текстовый файл 11.txt, когда программа запрашивала имя файла, я вводил 11.txt и все работало. 1

@Елена04 0 / 0 / 0 Регистрация: 27.05.2012 Сообщений: 18
	27.01.2013, 17:52 [ТС]
	Всё, разобралась, получилось) 0

@Елена04 0 / 0 / 0 Регистрация: 27.05.2012 Сообщений: 18
	28.01.2013, 01:47 [ТС]
	Еще один вопрос: при выводе на экран, когда я ввожу название файла, потом список выводится:1, 2 и q. Так вот когда я 2 нажимаю, по-моему какая-то ерунда получается, какая-то недоделанная таблица( Как это исправить? Это косяк в коде программы или это я не так что-то делаю? Миниатюры 0

@Елена04 0 / 0 / 0 Регистрация: 27.05.2012 Сообщений: 18
	28.01.2013, 21:32 [ТС]
	А Вы не могли бы еще один модуль составить? 0