Форум программистов, компьютерный форум, киберфорум
Наши страницы
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
CFYZ
10 / 10 / 4
Регистрация: 21.11.2009
Сообщений: 187
#1

Блок-схема - Turbo Pascal

09.02.2010, 23:55. Просмотров 352. Ответов 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
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
program lab8;
Uses crt;
Type price=record
  num:integer;
  mag:string[10];
  tov:string[15];
  st:integer;
  end;
var
p:file of price;
t1,t2:price;
procedure print_file;
begin
seek(p,0);
Textcolor(13);
writeln('________________________________________________________________________________');
writeln('            Magazin   ':15,'           Tovar            ':5,     '         Stoimost    ':10);
writeln('________________________________________________________________________________');
while not eof(p) do
 begin
 read(p,t1);
textcolor(14);
 writeln('   ',t1.mag:15,'               ',t1.tov:5,'              ',t1.st:10,' grn');
 writeln('________________________________________________________________________________');
textcolor(15);
 end;
readln;
end;
 
Procedure Create_file;
var
 i:integer;
begin
Clrscr;
Seek(p, FileSize(p));
writeln('Vvedite svedeniya o tovarah');
writeln('Dlya vbIhpda napechataite "*"');
writeln('________________________________________________________________________________');
while True do
 begin
Textcolor(10);
 Write('Vvedite magazin: ');
 readln(t1.mag);
 if t1.mag='*' then Break;
Textcolor(12);
 write('Nazvanie tovara: ');
 readln(t1.tov);
Textcolor(14);
 write('Stoimost: ');
 readln(t1.st);
 write(p,t1)
 end;
end;
 
procedure sort_by_name;
var i,j,k:integer;
m:array[1..150]of price;
b:price;
begin
 k:=0;
 reset(p);
 while not eof(p) do
 begin
  read(p,b);
  inc(k);
  m[k]:=b;
 end;
 for i:=1 to k do
 for j:=1 to k-1 do
 if m[j].mag>m[j+1].mag then
 begin
  b:=m[j];
  m[j]:=m[j+1];
  m[j+1]:=b;
 end;
 rewrite(p);
 for i:=1 to k do write(p,m[i]);
end; 
 
Procedure Poisk;
var Found:boolean;
s:string[10];
 
begin
While true do begin
writeln('Vvedite nazvanie magazina');
readln(s);
if s='*' then break;
found:=false;
seek(p,0);
writeln('            Magazin   ':15,'           Tovar            ':5,     '         Stoimost    ':10);
while not eof(p) and not found do
begin
read(p,t1);
 
if (Pos(s,t1.mag)<>0) then
begin
 
writeln('________________________________________________________________________________');
writeln('   ',t1.mag:15,'               ',t1.tov:5,'                ',t1.st:10,' grn');
writeln('________________________________________________________________________________');
 
end;
end;
if (Pos(s,t1.mag)=0) then
begin
Textcolor(4);
writeln ('                 ');
writeln ('                 ');
writeln ('                         |Takogo magazina HET|');
writeln ('                 ');
textcolor(15);
end;
end;
readln;
end;
 
procedure Vse_mag;
begin
seek(p,0);
Textcolor(13);
writeln('________________________________________________________________________________');
writeln('                       Spisok vseh magazinov':15);
writeln('________________________________________________________________________________');
while not eof(p) do
 begin
 read(p,t1);
textcolor(14);
 write(t1.mag:15);
 textcolor(15);
 end;
readln;
end;
 
 
Procedure menu;
var
 Number:integer;
begin
 
TextBackground(9);
while true do
 begin
 clrscr;
 while true do
  begin
  clrscr;
textcolor(11);
  writeln('________________________________________________________________________________');
  writeln('1 - Sozdanie faila ');
  writeln('2 - Vse magazinbI');
  writeln('3 - Sortirivka');
  writeln('4 - Poisk');
  writeln('5 - Spisok');
  writeln('6 - Vyhod');
  writeln('________________________________________________________________________________');
  writeln('                             Vvedite nomer punkta menu');
textcolor(15);
readln(Number);
  case Number of
   1:Create_file;
   2:Print_file;
   3:Sort_by_name;
   4:Poisk;
   5:Vse_mag;   
   6:Exit;
   end;
  end;
 end;
end;
 
begin
clrscr;
assign(p,'price.dat');
{$I-}
reset(p);
{$I+}
if IOResult=0 then 
writeln('                            Dobavlenie zapisei v suchestvuechiy fail')
 else
  begin
  rewrite(p);
writeln('                                         Zapis v novii fail');
  end;
readln;
menu;
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
09.02.2010, 23:55
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Блок-схема (Turbo Pascal):

Блок схема.
Ребята дскажите пожалуйста верна ли блок-схема построенна по программе. ...

блок-схема
помогите с блок-схемой uses crt; const n=8; type mas=array of real;...

блок-схема
program Z6; uses Crt; type cRecord = record Text: string; Count:...

блок-схема
Program L; Var I,N : Integer; F : File Of String; S : String; Begin...

Блок схема
Код: uses crt; type mas = array of real; procedure Smooth(var a: mas; n:...

блок-схема
Еще раз здравствуйте! Прошу, помогите с блок-схемами, буду очень благодарен!...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
09.02.2010, 23:55
Привет! Вот еще темы с решениями:

Блок схема
Помогите пожалуйста составить блок схему к данной программе program massiv;...

Блок-схема
Помогите пожалуйста сделать блок схему к задаче uses crt; type f=file of...

Блок схема
Помогите пожалуйста нарисоват блок схему! uses crt; var a,b:array of...

блок схема
7. Дан двумерный массив. Найти минимальное число и местоположение его в...


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

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

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