Форум программистов, компьютерный форум, киберфорум
Наши страницы

Turbo Pascal

Войти
Регистрация
Восстановить пароль
 
CFYZ
10 / 10 / 0
Регистрация: 21.11.2009
Сообщений: 187
#1

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

09.02.2010, 23:55. Просмотров 344. Ответов 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):

Блок-схема - Turbo Pascal
Помогите нарисовать блок-схему по составленной программе!!! Program matrixx; Const k=10; Type matrix= Array of integer; ...

Блок схема - Turbo Pascal
Помогите пожалуйста построить блок схему по этим программам. program L7; var z,h,c:real; const a=1.4; b=-0.52; begin z:=1; ...

блок-схема!!! - Turbo Pascal
program p24; uses crt; type mas=array of real; procedure readMas(var M:mas;n:integer;s:char); var i,k:integer; begin ...

блок-схема - Turbo Pascal
Всем привет! появилась небольшая трудность в написании блок-схемы: в общем у меня используется Case of end, всего выбор из 6 чисел, от...

Блок схема - Turbo Pascal
Код: uses crt; type mas = array of real; procedure Smooth(var a: mas; n: byte); var i,k: byte; s: real; begin

Блок схема - Turbo Pascal
Помогите пожалуйста составить блок схему к данной программе program massiv; type mas=array of real; var x,y,a,b:mas; ...

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

Блок-схема - Turbo Pascal
ПОгите сосТавить блок-хему к програмее 1)-{Первая программа} uses crt; var f1,f2,f3:file of real; n,i,j:integer; a,b:real; ...

блок схема - Turbo Pascal
помогите составить блок схему проге: const t='text.txt'; var f=text; st: string; begin assign(f,t); reset(f); ...

блок схема - Turbo Pascal
помогите пожалуйста составить блок схему к проге: var st:...

блок схема - Turbo Pascal
function SumC(n:integer):integer; var s:integer; begin s:=0; while N&gt;0 do begin s:=s+n mod 10; n:=n div 10; end; sumc:=s;...


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

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

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