Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль) > Pascal ABC
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
2 / 2 / 4
Регистрация: 10.11.2013
Сообщений: 140

Перевести код с TurboPascal 7.0 в PascalABC

09.12.2013, 21:35. Показов 1031. Ответов 10
Метки нет (Все метки)
Студворк — интернет-сервис помощи студентам
Добрый вечер форумчане! помогите эти строки перевести в PascalABC
"AssignFile(f,FNamme);
{$I-}
reset(f);
{$I+}
if IOResult<>0 then"
они работают только на TurboPascal 7.0, заранее благодарен.
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

type Price=record  //запись
     tovar: string[20]; //поля записи
     mag: string[12];
     stoim: string[10] ;
   end;
var
  f: file of Price; //текстовый файл
  Buf: price;
  spisok: array [1..1000] of Price;
  N:integer;
  nfile: string;
Procedure sozd(FNamme:string); //процедура создания файла
 var i,j: integer;
  begin
  AssignFile(f,FNamme);
  Rewrite(f);
  writeln('СОЗДАНИЕ ФАЙЛА  ЗАПИСЕЙ ТОВАРОВ');
  writeln('******************************');
  for i := 1 to 5 do   begin //запускаем цикл с параметром для записи файла
  writeln('Ввести ',i,' - ю запись');
  with buf do begin
  write('Введите название Товара: ');
  readln(tovar); //записываем в файл данные
  write('Введите название магазина, в котором продается товар: ');
  readln(mag);
  write('Стоимость товара в тенге: ');
  readln(stoim);
  end;
  write(f,buf);
  end;
  writeln('Ввод данных закончен');
  close(f);
  end;
Procedure prosm(FNamme:string);   //процедура просмотра файла
 var Tmp:Price;
 i,j: integer;
  begin
  AssignFile(f,FNamme);
  {$I-}
  reset(f);
  {$I+}
  if IOResult<>0 then
   begin
     writeln('Ошибка открытия файла');
     exit;
   end;
  writeln('ЧТЕНИЕ  МАССИВА  ЗАПИСЕЙ');
  writeln('**************************');
  writeln;
  writeln('_______________________________________________');
  writeln('  N   Товар       Магазин    Стоимость');
  writeln('_______________________________________________');
  n:=1;
  while not eof(f) do
  begin
   read(f,buf);
   spisok[n]:=buf;
   inc(n);
  end;
   for i := 1 to N-1 do           {~~~~~~Сортировка по алфавиту~~~~~~}
  for j:=i+1 to n do
  if spisok[i].tovar > spisok[j].tovar then begin
  tmp:=spisok[i]; spisok[i]:=spisok[j]; spisok[j]:=tmp;
  end;
  for i := 1 to N do
  with spisok[i] do begin
  writeln(i:3,tovar:15,mag:10,stoim:13);
  end;
  writeln('_______________________________________________');
  writeln('Конец просмотра');
  readln;
  close(f);
  end;
 
Procedure vibor(FNamme:string);   //процедура поиска информации
  var m:integer; tv:string; ff:boolean;  //описание переменных процедуры
  i,j:integer;
  begin
    AssignFile(f,FNamme);
  {$I-}
  reset(f);
  {$I+}
  if IOResult<>0 then
   begin
     writeln('Ошибка открытия файла');
     exit;
   end;
  writeln('Поиск товаров по алфавиту');
  writeln('**************************');
  writeln;
  write('Ввести букву: ');
  readln(tv); //считываем данные введенные с клавиатуры
  writeln('Поиск по алфавиту ',tv );
  writeln('****************************');
  writeln;
  writeln('_______________________________________________');
  writeln('  N   Товар       Магазин    Стоимость');
  writeln('_______________________________________________');
  i:=1;
  ff:=false;
  while not eof(f) do
  begin
  read(f,buf);
  if buf.tovar=tv then
   begin
    writeln(i:3,buf.tovar:15,buf.mag:10,buf.stoim:13);
    inc(i);
    ff:=true;
   end;
  end;
  if not ff then
  begin
   writeln('Такой записи нет');readln;
  end;
   writeln('Поиск товаров закончен');
   readln;
   close(f);
 end;
 var k:integer;
     Fn:string;
BEGIN
write('Wedite file name');readln(Fn);
  repeat    //цикл с постусловием
  Writeln('--------------ПОЛЬЗОВАТЕЛЬСКОЕ МЕНЮ------'  );
  writeln('-----------------------------------------');
  writeln('1. Создание файла записей ');
  writeln('2. Просмотр массива записей с сортировкой');
  writeln('3. Поиск товара по алфавиту');
  writeln('4. Выход');
  writeln('-----------------------------------------');
  write('Ваш выбор ');
  readln(k);
  case k of  //условный оператор выбора
  1:sozd(Fn);
  2:prosm(Fn);
  3:vibor(Fn);
  4:;{Выход}
  else begin
  writeln('нет такого пункта');
  readln;
  end;
  end;        {case}
  until k=4; //цикл с постусловием
  writeln('Конец программы');
  readln;
END.
0
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
 09.12.2013, 21:35
Ответы с готовыми решениями:

Нужно перевести программу с TurboPascal на PascalABC
Program Use_graph_mode; Uses Crt,graph; label o,e; Var s:real; q,i:integer; exit,x,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10:string;...

Перевести модуль, написанный на TurboPascal на PascalABC
Есть модуль - он написан на TurboPascal. Он связан с расчётом коэффициента отражения и операциями с комплексными числами! Название этого...

Перевести код pascal abc в Turbopascal
var a,b,c : real; begin Writeln('Значенеи в км/час'); Readln(a); Writeln('Значение м/с'); Readln(b); c:= (a*1000/3600) ; if...

10
561 / 484 / 168
Регистрация: 14.02.2012
Сообщений: 1,561
09.12.2013, 21:40
Цитата Сообщение от IsoPanzer Посмотреть сообщение
Pascal
1
2
3
4
5

AssignFile(f,FNamme);
{$I-}
reset(f);
{$I+}
if IOResult<>0 then
Директивы и проверку IOResult удаляете. Для работы с файлами используете assign, reset.
0
2 / 2 / 4
Регистрация: 10.11.2013
Сообщений: 140
09.12.2013, 22:16  [ТС]
Цитата Сообщение от ВАСИЛЕВС Посмотреть сообщение
Директивы и проверку IOResult удаляете. Для работы с файлами используете assign, reset.
а если так использовать
Pascal
1
2
3
4
5
6

2Assign(f,FNamme);
  if FileExistst ('spisok.txt') then
   begin
     reset (f);
     seek(f,filesize(f))
     end
0
561 / 484 / 168
Регистрация: 14.02.2012
Сообщений: 1,561
09.12.2013, 22:21
Ну так перед работой с файлом надо проверить его существование. Заодно есть возможность перехватить ошибки.
Pascal
1
2
3
4
5
6
7
8

if FileExistst ('spisok.txt') then
 begin
  Assign(f, FNamme);
  reset(f);
  seek(f, filesize(f))
 end
else
 write('Error!');
0
2 / 2 / 4
Регистрация: 10.11.2013
Сообщений: 140
09.12.2013, 22:35  [ТС]
при компилировании выводит ошибку неизвестный идентификатор, но если я его в var вставляю, тоже ошибка, из-за чего она может быть?
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

type Price=record  //запись
     tovar: string[20]; //поля записи
     mag: string[12];
     stoim: string[10] ;
   end;
var
  f: file of Price; //текстовый файл
  Buf: price;
  spisok: array [1..1000] of Price;
  N:integer;
  nfile: string;
Procedure sozd(FNamme:string); //процедура создания файла
 var i,j: integer;
  begin
  Assign(f,FNamme);
  Rewrite(f);
  writeln('СОЗДАНИЕ ФАЙЛА  ЗАПИСЕЙ ТОВАРОВ');
  writeln('******************************');
  for i := 1 to 5 do   begin //запускаем цикл с параметром для записи файла
  writeln('Ввести ',i,' - ю запись');
  with buf do begin
  write('Введите название Товара: ');
  readln(tovar); //записываем в файл данные
  write('Введите название магазина, в котором продается товар: ');
  readln(mag);
  write('Стоимость товара в тенге: ');
  readln(stoim);
  end;
  write(f,buf);
  end;
  writeln('Ввод данных закончен');
  close(f);
  end;
Procedure prosm(FNamme:string);   //процедура просмотра файла
 var Tmp:Price;
 i,j: integer;
  begin
  if FileExistst ('spisok.txt') then
 begin
  Assign(f, FNamme);
  reset(f);
  seek(f, filesize(f))
 end
else
 write('Error!');
     exit;
   end;
  writeln('ЧТЕНИЕ  МАССИВА  ЗАПИСЕЙ');
  writeln('**************************');
  writeln;
  writeln('_______________________________________________');
  writeln('  N   Товар       Магазин    Стоимость');
  writeln('_______________________________________________');
  n:=1;
  while not eof(f) do
  begin
   read(f,buf);
   spisok[n]:=buf;
   inc(n);
  end;
   for i := 1 to N-1 do           {~~~~~~Сортировка по алфавиту~~~~~~}
  for j:=i+1 to n do
  if spisok[i].tovar > spisok[j].tovar then begin
  tmp:=spisok[i]; spisok[i]:=spisok[j]; spisok[j]:=tmp;
  end;
  for i := 1 to N do
  with spisok[i] do begin
  writeln(i:3,tovar:15,mag:10,stoim:13);
  end;
  writeln('_______________________________________________');
  writeln('Конец просмотра');
  readln;
  close(f);
  end;
 
Procedure vibor(FNamme:string);   //процедура поиска информации
  var m:integer; tv:string; ff:boolean;  //описание переменных процедуры
  i,j:integer;
  begin
    AssignFile(f,FNamme);
  {$I-}
  reset(f);
  {$I+}
  if IOResult<>0 then
   begin
     writeln('Ошибка открытия файла');
     exit;
   end;
  writeln('Поиск товаров по алфавиту');
  writeln('**************************');
  writeln;
  write('Ввести букву: ');
  readln(tv); //считываем данные введенные с клавиатуры
  writeln('Поиск по алфавиту ',tv );
  writeln('****************************');
  writeln;
  writeln('_______________________________________________');
  writeln('  N   Товар       Магазин    Стоимость');
  writeln('_______________________________________________');
  i:=1;
  ff:=false;
  while not eof(f) do
  begin
  read(f,buf);
  if buf.tovar=tv then
   begin
    writeln(i:3,buf.tovar:15,buf.mag:10,buf.stoim:13);
    inc(i);
    ff:=true;
   end;
  end;
  if not ff then
  begin
   writeln('Такой записи нет');readln;
  end;
   writeln('Поиск товаров закончен');
   readln;
   close(f);
 end;
 var k:integer;
     Fn:string;
BEGIN
write('Wedite file name');readln(Fn);
  repeat    //цикл с постусловием
  Writeln('--------------ПОЛЬЗОВАТЕЛЬСКОЕ МЕНЮ------'  );
  writeln('-----------------------------------------');
  writeln('1. Создание файла записей ');
  writeln('2. Просмотр массива записей с сортировкой');
  writeln('3. Поиск товара по алфавиту');
  writeln('4. Выход');
  writeln('-----------------------------------------');
  write('Ваш выбор ');
  readln(k);
  case k of  //условный оператор выбора
  1:sozd(Fn);
  2:prosm(Fn);
  3:vibor(Fn);
  4:;{Выход}
  else begin
  writeln('нет такого пункта');
  readln;
  end;
  end;        {case}
  until k=4; //цикл с постусловием
  writeln('Конец программы');
  readln;
END.
0
561 / 484 / 168
Регистрация: 14.02.2012
Сообщений: 1,561
09.12.2013, 22:40
Цитата Сообщение от IsoPanzer Посмотреть сообщение
из-за чего она может быть?
Вы не правильно написали, а я копирнул не глядя
Цитата Сообщение от IsoPanzer Посмотреть сообщение
FileExistst
Должно быть FileExists.
0
2 / 2 / 4
Регистрация: 10.11.2013
Сообщений: 140
09.12.2013, 22:53  [ТС]
Цитата Сообщение от ВАСИЛЕВС Посмотреть сообщение
Вы не правильно написали, а я копирнул не глядя

Должно быть FileExists.
бывает))), кстати тут у меня выходит ошибка неизвестный идинтификатор i, мне нужно что ли опять процедуру еще одну созжать?
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
148

type Price=record  //запись
     tovar: string[20]; //поля записи
     mag: string[12];
     stoim: string[10] ;
   end;
var
  f: file of Price; //текстовый файл
  Buf: price;
  spisok: array [1..1000] of Price;
  N:integer;
  nfile: string;
Procedure sozd(FNamme:string); //процедура создания файла
 var i,j: integer;
  begin
  Assign(f,FNamme);
  Rewrite(f);
  writeln('СОЗДАНИЕ ФАЙЛА  ЗАПИСЕЙ ТОВАРОВ');
  writeln('******************************');
  for i := 1 to 5 do   begin //запускаем цикл с параметром для записи файла
  writeln('Ввести ',i,' - ю запись');
  with buf do begin
  write('Введите название Товара: ');
  readln(tovar); //записываем в файл данные
  write('Введите название магазина, в котором продается товар: ');
  readln(mag);
  write('Стоимость товара в тенге: ');
  readln(stoim);
  end;
  write(f,buf);
  end;
  writeln('Ввод данных закончен');
  close(f);
  end;
Procedure prosm(FNamme:string);   //процедура просмотра файла
 var Tmp:Price;
 i,j: integer;
  begin
  if FileExists ('spisok.txt') then
 begin
  Assign(f, FNamme);
  reset(f);
  seek(f, filesize(f))
 end
else
 write('Error!');
     exit;
   end;
  begin
  writeln('ЧТЕНИЕ  МАССИВА  ЗАПИСЕЙ');
  writeln('**************************');
  writeln;
  writeln('_______________________________________________');
  writeln('  N   Товар       Магазин    Стоимость');
  writeln('_______________________________________________');
  n:=1;
  while not eof(f) do
  begin
   read(f,buf);
   spisok[n]:=buf;
   inc(n);
  end;
   for i := 1 to N-1 do           {~~~~~~Сортировка по алфавиту~~~~~~}
  for j:=i+1 to n do
  if spisok[i].tovar > spisok[j].tovar then begin
  tmp:=spisok[i]; spisok[i]:=spisok[j]; spisok[j]:=tmp;
  end;
  for i := 1 to N do
  with spisok[i] do begin
  writeln(i:3,tovar:15,mag:10,stoim:13);
  end;
  writeln('_______________________________________________');
  writeln('Конец просмотра');
  readln;
  close(f);
  end;
 
Procedure vibor(FNamme:string);   //процедура поиска информации
  var m:integer; tv:string; ff:boolean;  //описание переменных процедуры
  i,j:integer;
  begin
    AssignFile(f,FNamme);
  {$I-}
  reset(f);
  {$I+}
  if IOResult<>0 then
   begin
     writeln('Ошибка открытия файла');
     exit;
   end;
  writeln('Поиск товаров по алфавиту');
  writeln('**************************');
  writeln;
  write('Ввести букву: ');
  readln(tv); //считываем данные введенные с клавиатуры
  writeln('Поиск по алфавиту ',tv );
  writeln('****************************');
  writeln;
  writeln('_______________________________________________');
  writeln('  N   Товар       Магазин    Стоимость');
  writeln('_______________________________________________');
  i:=1;
  ff:=false;
  while not eof(f) do
  begin
  read(f,buf);
  if buf.tovar=tv then
   begin
    writeln(i:3,buf.tovar:15,buf.mag:10,buf.stoim:13);
    inc(i);
    ff:=true;
   end;
  end;
  if not ff then
  begin
   writeln('Такой записи нет');readln;
  end;
   writeln('Поиск товаров закончен');
   readln;
   close(f);
 end;
 var k:integer;
     Fn:string;
BEGIN
write('Wedite file name');readln(Fn);
  repeat    //цикл с постусловием
  Writeln('--------------ПОЛЬЗОВАТЕЛЬСКОЕ МЕНЮ------'  );
  writeln('-----------------------------------------');
  writeln('1. Создание файла записей ');
  writeln('2. Просмотр массива записей с сортировкой');
  writeln('3. Поиск товара по алфавиту');
  writeln('4. Выход');
  writeln('-----------------------------------------');
  write('Ваш выбор ');
  readln(k);
  case k of  //условный оператор выбора
  1:sozd(Fn);
  2:prosm(Fn);
  3:vibor(Fn);
  4:;{Выход}
  else begin
  writeln('нет такого пункта');
  readln;
  end;
  end;        {case}
  until k=4; //цикл с постусловием
  writeln('Конец программы');
  readln;
END.
0
561 / 484 / 168
Регистрация: 14.02.2012
Сообщений: 1,561
09.12.2013, 23:23
Пересмотрите процедуру prosm(), там не совпадает количество begin/end.
0
2 / 2 / 4
Регистрация: 10.11.2013
Сообщений: 140
09.12.2013, 23:41  [ТС]
Цитата Сообщение от ВАСИЛЕВС Посмотреть сообщение
Пересмотрите процедуру prosm(), там не совпадает количество begin/end.
вставил оператор begin... все равно ошибка выходит.
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
148
149

type Price=record  //запись
     tovar: string[20]; //поля записи
     mag: string[12];
     stoim: string[10] ;
   end;
var
  f: file of Price; //текстовый файл
  Buf: price;
  spisok: array [1..1000] of Price;
  N:integer;
  nfile: string;
Procedure sozd(FNamme:string); //процедура создания файла
 var i,j: integer;
  begin
  Assign(f,FNamme);
  Rewrite(f);
  writeln('СОЗДАНИЕ ФАЙЛА  ЗАПИСЕЙ ТОВАРОВ');
  writeln('******************************');
  for i := 1 to 5 do   begin //запускаем цикл с параметром для записи файла
  writeln('Ввести ',i,' - ю запись');
  with buf do begin
  write('Введите название Товара: ');
  readln(tovar); //записываем в файл данные
  write('Введите название магазина, в котором продается товар: ');
  readln(mag);
  write('Стоимость товара в тенге: ');
  readln(stoim);
  end;
  write(f,buf);
  end;
  writeln('Ввод данных закончен');
  close(f);
  end;
Procedure prosm(FNamme:string);   //процедура просмотра файла
 var Tmp:Price;
 i,j: integer;
  begin
  if FileExists ('spisok.txt') then
 begin
  Assign(f, FNamme);
  reset(f);
  seek(f, filesize(f))
 end
else
 write('Error!');
     exit;
   end;
  begin
  writeln('ЧТЕНИЕ  МАССИВА  ЗАПИСЕЙ');
  writeln('**************************');
  writeln;
  writeln('_______________________________________________');
  writeln('  N   Товар       Магазин    Стоимость');
  writeln('_______________________________________________');
  n:=1;
  while not eof(f) do
  begin
   read(f,buf);
   spisok[n]:=buf;
   inc(n);
  end;
begin
   for i := 1 to N-1 do           {~~~~~~Сортировка по алфавиту~~~~~~}
  for j:=i+1 to n do
  if spisok[i].tovar > spisok[j].tovar then begin
  tmp:=spisok[i]; spisok[i]:=spisok[j]; spisok[j]:=tmp;
  end;
  for i := 1 to N do
  with spisok[i] do begin
  writeln(i:3,tovar:15,mag:10,stoim:13);
  end;
  writeln('_______________________________________________');
  writeln('Конец просмотра');
  readln;
  close(f);
  end;
 
Procedure vibor(FNamme:string);   //процедура поиска информации
  var m:integer; tv:string; ff:boolean;  //описание переменных процедуры
  i,j:integer;
  begin
    AssignFile(f,FNamme);
  {$I-}
  reset(f);
  {$I+}
  if IOResult<>0 then
   begin
     writeln('Ошибка открытия файла');
     exit;
   end;
  writeln('Поиск товаров по алфавиту');
  writeln('**************************');
  writeln;
  write('Ввести букву: ');
  readln(tv); //считываем данные введенные с клавиатуры
  writeln('Поиск по алфавиту ',tv );
  writeln('****************************');
  writeln;
  writeln('_______________________________________________');
  writeln('  N   Товар       Магазин    Стоимость');
  writeln('_______________________________________________');
  i:=1;
  ff:=false;
  while not eof(f) do
  begin
  read(f,buf);
  if buf.tovar=tv then
   begin
    writeln(i:3,buf.tovar:15,buf.mag:10,buf.stoim:13);
    inc(i);
    ff:=true;
   end;
  end;
  if not ff then
  begin
   writeln('Такой записи нет');readln;
  end;
   writeln('Поиск товаров закончен');
   readln;
   close(f);
 end;
 var k:integer;
     Fn:string;
BEGIN
write('Wedite file name');readln(Fn);
  repeat    //цикл с постусловием
  Writeln('--------------ПОЛЬЗОВАТЕЛЬСКОЕ МЕНЮ------'  );
  writeln('-----------------------------------------');
  writeln('1. Создание файла записей ');
  writeln('2. Просмотр массива записей с сортировкой');
  writeln('3. Поиск товара по алфавиту');
  writeln('4. Выход');
  writeln('-----------------------------------------');
  write('Ваш выбор ');
  readln(k);
  case k of  //условный оператор выбора
  1:sozd(Fn);
  2:prosm(Fn);
  3:vibor(Fn);
  4:;{Выход}
  else begin
  writeln('нет такого пункта');
  readln;
  end;
  end;        {case}
  until k=4; //цикл с постусловием
  writeln('Конец программы');
  readln;
END.
0
561 / 484 / 168
Регистрация: 14.02.2012
Сообщений: 1,561
09.12.2013, 23:53
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

Procedure prosm(FNamme:string);   //процедура просмотра файла
var
 Tmp:Price;
 i, j: integer;
begin
 if FileExists ('spisok.txt') then
  begin
   Assign(f, FNamme);
   reset(f);
   seek(f, filesize(f))
  end
 else
  begin
   write('Error!');
   exit;
  end;
 writeln('ЧТЕНИЕ  МАССИВА  ЗАПИСЕЙ');
 writeln('**************************');
 writeln;
 writeln('_______________________________________________');
 writeln('  N   Товар       Магазин    Стоимость');
 writeln('_______________________________________________');
 n:=1;
 while not eof(f) do
  begin
   read(f,buf);
   spisok[n]:=buf;
   inc(n);
  end;
 
 for i := 1 to N-1 do           {~~~~~~Сортировка по алфавиту~~~~~~}
  for j:=i+1 to n do
   if spisok[i].tovar > spisok[j].tovar then
    begin
     tmp := spisok[i];
     spisok[i] := spisok[j];
     spisok[j]:=tmp;
    end;
 
 for i := 1 to N do
  with spisok[i] do
   writeln(i:3,tovar:15,mag:10,stoim:13);
   
 writeln('_______________________________________________');
 writeln('Конец просмотра');
 readln;
 close(f);
end;
Процедура должна быть не больше 10-20 строк, выравнивание надо соблюдать и одна команда на строку должна быть. Я пока эту портянку выровнял, пока удалил лишние блоки... Запомните! Вы пишите код в первую очередь для людей и только после этого для ПК.
0
2 / 2 / 4
Регистрация: 10.11.2013
Сообщений: 140
09.12.2013, 23:55  [ТС]
на практике я как то на это внимание не обращял, теперь возьму на вооружение.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
 09.12.2013, 23:55
Помогаю со студенческими работами здесь

Перевести код с PascalABC
uses graph; var x1,y1,x2,y2,x3,y3,x4,y4:integer; p:array of pointtype; begin initgraph(x1,y1,''); {определим координаты 4...

Перевести код из C++ в PascalABC
#include &lt;iostream&gt; //digiroot using namespace std; int digiroot(int number) { if (number == 0) return number; ...

Перевести код с PascalABC
uses crt,graphabc; type Pyr=array of real; Var F1,F2 : text; Ch,j : integer; var i,e:integer; a:real; xx,yy,zz:array of real;...

Можете перевести код с C# на PascalABC
static void Main(string args) { Random R = new Random(); int arr = new int ; ...

Перевести код с Си на PascalABC.NET
У меня такая проблема, есть программа на си а еще нужно написать на паскале (Паскаль АБЦ.нет), и никак не могу так как Паскаль я не очень...


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

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Новые блоги и статьи
PhpStorm 2025.3: WSL Terminal всегда стартует в ~
and_y87 14.12.2025
PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .
Access
VikBal 11.12.2025
Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.
Новый ноутбук
volvo 07.12.2025
Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro
 Музыка, написанная Искусственным Интеллектом
volvo 04.12.2025
Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .
От async/await к виртуальным потокам в Python
IndentationError 23.11.2025
Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов
Argus19 22.11.2025
Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .
Сколько Государство потратило денег на меня, обеспечивая инсулином.
Programma_Boinc 20.11.2025
Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .
Ломающие изменения в C#.NStar Alpha
Etyuhibosecyu 20.11.2025
Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .
Мысли в слух
kumehtar 18.11.2025
Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .
Создание Single Page Application на фреймах
krapotkin 16.11.2025
Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru