IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Помогите написать блок-схему к программе
gollum1
сообщение 26.05.2007 18:15
Сообщение #1





Группа: Пользователи
Сообщений: 1
Пол: Мужской

Репутация: -  0  +


uses crt,dos; 
label na4;
const
filepath='data.bd';
type
data = record
nomAt:integer;
nomKv:integer;
Dat1:string[10];
Dat2:string[10];
FIO:string[21];
vid:string[10];
end;

var
f:file of data;
bd:array[1..100]of data;
num,v:integer;

procedure PrintAll(fio:string);
var
i,j,kol:integer;
s1,s2,s3,s4,s5,s6:string;
mass:array[1..100] of integer;
print:boolean;
begin
clrscr;
textcolor(5);
writeln('At|','Kv|', 'Oformlenie|',' Vida4a |',' FIO |','Tovar');
writeln('____________________________________________________________________');
textcolor(2);
kol:=0;
if (fio<>'') then
for i:=1 to num do begin
if bd[i].fio=fio then
begin
kol:=kol+1;
mass[kol]:=i;
end;
end;
for i:=1 to num do begin
print:=true;
if (fio<>'') then begin
print:=false;
for j:=1 to kol do if i=mass[j] then print:=true;
end;
if print then begin
str(bd[i].NomAt:2,s1);
str(bd[i].NomKv:2,s2);
s3:=bd[i].dat1;
for j:=1 to 10-length(bd[i].dat1) do s3:=s3+' ';
s4:=bd[i].dat2;
for j:=1 to 10-length(bd[i].dat2) do s4:=s4+' ';
s5:=bd[i].fio;
for j:=1 to 21-length(bd[i].fio) do s5:=s5+' ';
s6:=bd[i].vid;
for j:=1 to 6-length(bd[i].vid) do s6:=s6+' ';
writeln(s1,'|',s2,'|',s3,'|',s4,'|',s5,'|',s6);
end;
end;
readln;
end;


procedure NewFile;
begin
assign(f,filepath);
rewrite(f);
close(f);
end;

procedure WriteToFile;
var
i:integer;
begin
assign(f,filepath);
rewrite(f);
for i:=1 to num do write(f,bd[i]);
close(f);
end;

procedure ReadfromFile;
begin
assign(f,filepath);
reset(f);
num:=0;
while(not eof(f)) do begin
num:=num+1;
read(f,bd[num]);
end;
close(f);
end;


procedure NewZap;
var
zap:data;
begin
clrscr;
gotoxy(10,5); write('Vvedite nomer atelye '); readln(zap.NomAt);
gotoxy(10,6); write('Vvedite nomer kvitancii ');readln(zap.Nomkv);
gotoxy(10,7); write('Vvedite data oformleniya ');readln(zap.dat1);
gotoxy(10,8); write('Vvedite data vida4i ');readln(zap.dat2);
gotoxy(10,9); write('Vvedite fio mastera ');readln(zap.fio);
gotoxy(10,10); write('Vvedite vid izdeliya ');readln(zap.Vid);
num:=num+1;
bd[num]:=zap;
clrscr;
end;

procedure FilterZap;
var
kol,i,j:integer;
fio:string[21];
begin
clrscr;
gotoxy(10,1); write('Viborka po FIO mastera...');
gotoxy(10,2); write('Vvedite iskomuu FIO: '); readln(fio);
PrintAll(fio);
clrscr;
end;

function find:boolean;
var
di:string;
begin
di:=FSearch('data.bd','');
if di='' then find:=false else find:=true;
end;

begin
if (not find) then NewFile else ReadFromFile;
na4:
clrscr;
gotoxy(15,1); write('Zapisei v BD ',num);
gotoxy(15,5); write('Dly dobavleniya zapisi v BD vvedite #1#');
gotoxy(15,6);write('Dly sortirovki BD vvedite #2#');
gotoxy(15,7);write('Dly prosmotra vsey BD vvedite #3#');
gotoxy(15,9);write('Dly VIHODA iz programmi vvedite #4#');
gotoxy(20,11);textcolor(2);write('Vibor: ');readln(v);
clrscr;
case v of
1:begin
NewZap;
WriteToFile;
goto na4;
end;
2:begin
FilterZap;
goto na4;
end;
3:begin
PrintAll('');
goto na4;
end;
4:begin
end;

end;

end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 1)
Ozzя
сообщение 29.05.2007 10:22
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


Программа построения блок-схем
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 19.07.2025 16:27
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"