Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 5.00/3: Рейтинг темы: голосов - 3, средняя оценка - 5.00
1 / 1 / 0
Регистрация: 02.11.2011
Сообщений: 16

Составить блок схему к готовому коду

13.12.2011, 22:58. Показов 599. Ответов 3
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
program ge;
uses crt;
CONST namebd='productbd.txt';
type vse=record
               nazv:string;
               sto:real;
               kol:real;
               mas:string;
         end;
 
var tovary:array [1..10] of vse;
    i,n:integer;
    f:text;
    back:integer;
 
procedure menu;   forward;
{********************************}
procedure readf; {считывание с файла}
var i:integer;
begin
assign(f,namebd); reset(f);
i:=0;
while not eof(f) do begin
inc(i);
readln(f,tovary[i].nazv);
readln(f,tovary[i].sto);
readln(f,tovary[i].kol);
readln(f,tovary[i].mas);
                    end;   n:=i;
close(f); end; {конец*считывание с файла*}
procedure writef; {меню записи в файл}
var i,option:integer;
    namef:string;
    newf:text;
begin
begin;
window(1,1,80,25);
   clrscr;
   textcolor(5);
   end;
assign(f,namebd); reset(f);
writeln;writeln;writeln;
writeln('"0" - Вернуться в меню '); writeln;
Writeln('1. перезаписать файл');
Writeln('2. записать в новый файл');
readln(option);
if option=0 then menu;
if option=1 then begin
close(f);
assign(f,namebd);
rewrite(f);
for i:=1 to n do                 begin
                                 writeln(f,tovary[i].nazv);
                                 writeln(f,tovary[i].sto:6:2);
                                 writeln(f,tovary[i].kol:6:2);
                                 writeln(f,tovary[i].mas);
                                 end;
                 close(f);
                 end;
if option=2 then begin  Writeln;writeln;writeln;
writeln('"0" - вернуться в меню'); writeln;
Writeln('введите новое имя файла (EX: "1.txt"): ');
readln(namef);
assign(newf,namef); rewrite(newf);
begin
if option=0 then menu;
end;
for i:=1 to n do                 begin
                                 writeln(newf,tovary[i].nazv);
                                 writeln(newf,tovary[i].sto:6:2);
                                 writeln(newf,tovary[i].kol:6:2);
                                 writeln(newf,tovary[i].mas);
                                 end;
                 close(newf);
                 end;
clrscr; writeln('Данные успешно записаны ...');
writeln('Press ENTER...');
readln;
menu;
end; {конец*меню записи в файл*}
 
{вывод на экран с "файловым меню"}
procedure vyvod;
var i,j,k:integer; b:string;
begin
clrscr;
writeln('#':3,'|','Название:':16,'| ','Стоимость товара:| ','  Кол-во:':10,'| ','Масса:|:10,');
writeln('_____________________________________________________');
for i:=1 to n do begin
str(tovary[i].sto,b);
if pos('.',b)=0 then b:=b+'00';
k:=10-length(b);
b:='';
for j:=1 to k do b:=b+' ';
writeln(i:3,'|',tovary[i].nazv:16,'| ',tovary[i].sto:2:2,' (тыс/тг)',b,'| ',tovary[i].kol:2:2,'(шт.) |',tovary[i].mas:16, '(кг)');
                 end;
writef; {fail}
end; {конец*вывод на экран*}
{вывод на экран без "файлового меню"}
procedure vyvod2;
var i,j,k:integer; b:string;
begin
clrscr;
writeln('#':3,'|','Название:':16,'| ','Стоимость:':16,'    |',' Кол-во:':13,'    |',' Масса:':16,',');
writeln('_______________________________________________________________________________');
for i:=1 to n do begin
str(tovary[i].sto,b);
if pos('.',b)=0 then b:=b+'00';
k:=10-length(b);
b:='';
for j:=1 to k do b:=b+' ';
writeln(i:3,'|',tovary[i].nazv:16,'| ',tovary[i].sto:2:2,' (тыс/тг)',b,'| ',tovary[i].kol:2:2,'(шт.)| ',tovary[i].mas:16,'(кг)');
                 end;
end; {конец*вывод на экран*}
{сортировка}
procedure exchange(var a,b:string);
var c:string;
begin
c:=a; a:=b; b:=c; end;
procedure exchangr(var a,b:real);
var c:real;
begin
c:=a; a:=b; b:=c; end;
procedure sortbukva(bukva:shortint);
var i,j,nn:integer;
    swop:boolean;
    vrs1,vrs2:string;
begin
nn:=n;
repeat
swop:=false;
for i:=1 to nn-1 do begin
vrs1:=tovary[i].nazv;
vrs2:=tovary[i+1].nazv;
if ord(vrs1[bukva])>ord(vrs2[bukva]) then begin         {esli "<" togda po ubivaniiu }
exchange(tovary[i].nazv,tovary[i+1].nazv);
exchangr(tovary[i].sto,tovary[i+1].sto);
exchangr(tovary[i].kol,tovary[i+1].kol);
exchange(tovary[i].mas,tovary[i+1].mas);
swop:=true;                       end;
                                  end;
nn:=nn-1;
until not swop;
end;
 
procedure sortcena;
var i,j,nn:integer;
    swop:boolean;
begin
nn:=n;
repeat
swop:=false;
for i:=1 to nn-1 do begin
if tovary[i].sto>tovary[i+1].sto then begin         {esli "<" togda po ubivaniiu }
exchange(tovary[i].nazv,tovary[i+1].nazv);
exchangr(tovary[i].sto,tovary[i+1].sto);
exchangr(tovary[i].kol,tovary[i+1].kol);
exchange(tovary[i].mas,tovary[i+1].mas);
swop:=true;                       end;
                                  end;
nn:=nn-1;
until not swop;
end;
procedure sort;
var i,option:integer;
begin
clrscr;
writeln ('"0"- вернуться в меню');
writeln(' ');
writeln('1.Сортировать по названию');
writeln('2. Сортировать по стоимости');
 
 
writeln;
write('введите цифру из меню: ');
readln(option);
readf;
begin
if option=0 then menu;
end;
if option=1 then                                      begin
for i:=3 downto 1 do   sortbukva(i); vyvod;           end;
if option=2 then begin readf; sortcena; vyvod; end;
end;
{конец*сортировка*}
procedure korrekcia;  {проводит корректировку или дополнение списка с клавиатуры}
var i,option,nomer:integer;
begin
readf;
vyvod2;
writeln('"0" - вернуться в МЕНЮ'); writeln;
writeln('1.Корректировать записи ');
writeln('2.Дополнить список');
write('Введите цифру из меню: ');
readln(option);
begin
if option=0 then menu;
end;
if option=1 then begin
                 write('Введите записи # записи, которую желаете  откорректировать: ');
                 readln(nomer);
                 writeln;
                 writeln('название: ');         readln(tovary[nomer].nazv);
                 writeln('стоимость товара: '); readln(tovary[nomer].sto);
                 writeln(': ');           readln(tovary[nomer].kol);
                 writeln('Единица измирения: ');readln(tovary[nomer].mas);
                 vyvod;
                 end;
if option=2 then begin
                 clrscr;
                 write('Введите количество  дополнительных  записей: ');
                 readln(nomer);
                 writeln;
                 for i:=1 to nomer do  begin
                                        inc(n); {увеличиваем общее кол-во записей}
                                        writeln('Добовляем ',n,' записи:');
                                        writeln('Название: ');         readln(tovary[n].nazv);
                                        writeln('Стоимость товара: '); readln(tovary[n].sto);
                                        writeln('Количество : ');           readln(tovary[n].kol);
                                        writeln('Единица измерения : ');readln(tovary[n].mas);
                                        vyvod;
                                        end;
                                      end;
end; {конец*проводит корректировку или дополнение списка с клавиатуры*}
procedure view; {Вывод на экран информации о товаре, название которого введено с клавиатуры}
var i,option:integer; s:string;
begin
assign(f,namebd); reset(f);
clrscr;
writeln('"0" - вернуться в МЕНЮ'); writeln;
write('Введите название товара: ');
readln(s,option);
begin
if option=0 then menu;
end;
for i:=1 to n do
if tovary[i].nazv=s then begin
                         writeln('Название: ',tovary[i].nazv);
                         writeln('Цена:     ',tovary[i].sto);
                         writeln('Количество:   ',tovary[i].kol,' ',tovary[i].mas);
                         end;
 
readln; menu;
end; {конец*Вывод на экран информации о товаре, название которого введено с клавиатуры*}
{***************MENU*******************}
procedure menu;
var option:integer;
begin
begin;
window(1,1,80,25);
   clrscr;
   textcolor(5);
   end;
clrscr;
writeln('Меню программы: ');  writeln;
textcolor (19);
writeln('1. Корректировка или дополнение списка с клавиатуры ');
writeln('2. Сортировка по названию товара или по общей стоимости ');
writeln('3. Вывод  на экран информации о товаре ,  название которого введено с клавиатуры');
writeln('4. Вывод всей информации (БАЗЫ)  с файла');
writeln;
textcolor (5);
write('Введите цифру из меню: ');
readln(option);
if option=1 then korrekcia;
if option=2 then sort;
if option=3 then view;
if option=4 then begin
                 readf;
                 vyvod;
                 end;
end;
{end*************MENU*******************}
{***********************Начало программы***************************}
begin
menu;
readln;
end.
0
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
13.12.2011, 22:58
Ответы с готовыми решениями:

Составить блок схему к готовому коду
uses crt; const nmax=15; var a:array of integer; n,m,i,j,k:integer; begin randomize; repeat write('Размер матрицы до...

Составить блок-схему по готовому коду
program mtx; uses crt; const n=3; var a: array of integer; i,j,x,y: integer; refl,irefl,simetr: boolean; ...

Составить блок-схему к готовому коду
составить блок схему к: program tt; var Xn, Xk, Xd, z, x:real; begin writeln('введите значение Xn'); readln(Xn); ...

3
3 / 3 / 0
Регистрация: 13.10.2011
Сообщений: 29
13.12.2011, 23:54
а почему такая короткая, подлиннее давай
0
1 / 1 / 0
Регистрация: 02.11.2011
Сообщений: 16
13.12.2011, 23:55  [ТС]
Извини. Тока такие))))
0
1 / 1 / 0
Регистрация: 21.11.2011
Сообщений: 3
14.12.2011, 00:13
Есть прога по построению блок схем(Построение Блок-схем.exe) она тебе в помощь)))
1
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
14.12.2011, 00:13
Помогаю со студенческими работами здесь

Составить блок схему к готовому коду
нужно сделать блок-схему ,пожалуйста помогите:-uses graphABC; function F(x:real):real; begin F:=0.5*x*x+4*x-3; end; var...

Составить блок схему к готовому коду
Помогите нарисовать блок схему

Составить блок схему к готовому коду
program prost; function prime(N: integer): boolean; var i: integer; begin if N &lt; 2 then prime := False ...

Составить блок схему к готовому коду
Сделайте к проге схемы пожалуйста. program Array17; uses crt; var a: array of byte; i:byte; N:byte; begin ...

Составить блок схему к готовому коду
Var a:array of integer; m, n, i, b1, b:integer; begin write('введите год '); readln(n); write('введите месяц '); readln(m); ...


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

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Новые блоги и статьи
Камера Toupcam IUA500KMA
Eddy_Em 12.02.2026
Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу
zbw 12.02.2026
И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.
«Знание-Сила»
zbw 12.02.2026
«Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров
8Observer8 12.02.2026
Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .
SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image)
8Observer8 11.02.2026
Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .
SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image
8Observer8 10.02.2026
Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .
Установка Qt-версии Lazarus IDE в Debian Trixie Xfce
volvo 10.02.2026
В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .
SDL3 для Web (WebAssembly): Работа со звуком через SDL3_mixer
8Observer8 08.02.2026
Содержание блога Пошагово создадим проект для загрузки звукового файла и воспроизведения звука с помощью библиотеки SDL3_mixer. Звук будет воспроизводиться по клику мышки по холсту на Desktop и по. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru