Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Войти
Регистрация
Восстановить пароль
Другие темы раздела
Pascal ABC Матрица: Среди столбцов целочисленной матрицы найти столбец с минимальным произведением элементов https://www.cyberforum.ru/ pascalabc/ thread772449.html
Среди столбцов целочисленной матрицы А(n,m) найти столбец с минимальным произведением элементов.Заранее спасибо:curtsy:
Pascal ABC Дана последовательность цифр, представляющая собой записанные подряд ноль и 20 первых натуральных чисел
Дана последовательность цифр, представляющая собой записанные подряд ноль и 20 первых натуральных чисел. Найти цифру c номером n в этой последовательности (1 ≤ n ≤ 32).
Дано натуральное число n (1 ≤ n ≤ 1188), определяющее возраст человека (в месяцах) Pascal ABC
Дано натуральное число n (1 ≤ n ≤ 1188), определяющее возраст человека (в месяцах). Выразить возраст в годах и месяцах, например, 21 год 10 месяцев, 52 года 1 месяц, 46 лет ровно и т. п.
Pascal ABC С начала 1990 года по некоторый день прошло n месяцев и 2 дня (n ≥ 1) С начала 1990 года по некоторый день прошло n месяцев и 2 дня (n ≥ 1). Определить название месяца (январь, февраль и т. п.) этого дня. https://www.cyberforum.ru/ pascalabc/ thread772404.html
Pascal ABC Составить программу, которая уменьшает первое введенное число в два раза https://www.cyberforum.ru/ pascalabc/ thread772400.html
Составить программу, которая уменьшает первое введенное число в два раза, если оно больше второго введенного числа по абсолютной величине.
Pascal ABC Дано натуральное число n (n < 9999). Выяснить, верно ли, что это число содержит ровно три одинаковые цифры
Дано натуральное число n (n < 9999). Выяснить, верно ли, что это число содержит ровно три одинаковые цифры, если оно записано четырьмя цифрами, как, например, числа 3363, 4844, 0300 и т. п.
Pascal ABC Поле шахматной доски определяется парой натуральных чисел
Поле шахматной доски определяется парой натуральных чисел, каждое из которых не превосходит восьми: первое число — номер вертикали (при счете слева направо), второе — номер горизонтали (при счете...
Pascal ABC Определить, верно ли, что при делении неотрицательного целого числа a Определить, верно ли, что при делении неотрицательного целого числа a на положительное число b получается остаток, равный одному из двух заданных чисел c или d. https://www.cyberforum.ru/ pascalabc/ thread772395.html
Pascal ABC Имеется стол прямоугольной формы размером a × b https://www.cyberforum.ru/ pascalabc/ thread772394.html
Имеется стол прямоугольной формы размером a × b (a и b - целые числа, a > b). В каком случае на столе можно разместить большее количество картонных прямоугольников с размерами c × d (c и d —...
Pascal ABC Найти среднее арифметическое по столбцам произвольной матрицы Найти среднее арифметическое по столбцам произвольной матрицы. Столбец с наибольшим средним записать отдельно. В исходной матрице заменить его нулями https://www.cyberforum.ru/ pascalabc/ thread772389.html
Модератор
62542 / 46715 / 32198
Регистрация: 18.05.2008
Сообщений: 113,062
27.01.2013, 09:11 0

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

27.01.2013, 09:11. Просмотров 1990. Ответов 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.{конец программы}


Вернуться к обсуждению:
Переделайте программу из Turbo Pascal в PascalABC
1
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
27.01.2013, 09:11
Готовые ответы и решения:

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

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

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

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

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