Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.06.2010, 12:50   #1
Lev.F
Пользователь
 
Регистрация: 28.05.2010
Сообщений: 30
Подмигивание Блок -Схема

Помогите сделать Блок-Схему по этой программе
uses wincrt;
const nbr = 10;
type
v=array [1..3] of string;
x=array[1..nbr] of string;
procedure split(line: string; var person:v);
var
n, i: integer;
begin
n := 1;
for i:=1 to length(line) do
begin
if line[i] <> ' ' then
person[n] := person[n] + line[i]
else
begin
inc(n);
end;
end;
end;
procedure sort(var names:x; n: integer);
var
i, j, k: integer;
min: string;
begin
for j:=0 to n-2 do
for i:=j+1 to n-1 do
begin
k := 1;
while (names[i][k] = names[j][k]) and (k <= length(names[i])) do
inc(k);
if names[i][k] < names[j][k] then
begin
min := names[i];
names[i] := names[j];
names[j] := min;
end;
end;
end;
var
line: string;
person:v;
last:x;
first:x ;
middle:x;
i, num,col:integer;
begin
i := 1;
writeln('Введите количество человек');
readln(col);
while col>=i do
begin
writeln('введите ФИО');
readln(line);
person[1] := '';
person[2] := '';
person[3] := '';
split(line, person);
last[i] := person[1];
first[i] := person[2];
middle[i] := person[3];
inc(i);
end;
num := i - 1;
writeln('Отчества в алфавитном порядке:');
sort(middle, num);
for i:=1 to num do
writeln(middle[i]);
writeln('');
writeln('Список фамилий и имен:');
for i:=1 to num do
begin
writeln(last[i] + ' ' + first[i]);
end;
end.
Lev.F вне форума Ответить с цитированием
Старый 13.06.2010, 13:05   #2
ROMA2PVT
ТАМБОВСКИЙ ВОЛК.
Участник клуба
 
Аватар для ROMA2PVT
 
Регистрация: 16.03.2010
Сообщений: 1,354
По умолчанию

Добавляй блок описания переменных.И начало подпрограммы оформляй в той фигуре(с именем подпрограммы) в которой происходит вызов подпрограммы в основной программе.
Вложения
Тип файла: rar Блок-схема.rar (77.2 Кб, 12 просмотров)
にんじゃ
ROMA2PVT вне форума Ответить с цитированием
Старый 13.06.2010, 13:45   #3
Sos1
Пользователь
 
Регистрация: 07.06.2010
Сообщений: 12
По умолчанию

program telefon;
uses crt;
type room=record
nmb:integer;
name:string[20];
end;
type abonent=record
rabota:string[30];
familia:string[20];
imya:string[15];
end;
type tfon=record
troom:room;
abont:abonent;
ntfon:longint;
end;
var
ftfon:array[1..100] of tfon;
n,i,nt,j,t:integer;
k:1..9;
na:string[20];
procedure vvod;
begin
write('kolichestvo zapisei='); readln(n);
for i:=1 to n do begin
write('familia='); readln(ftfon[i].abont.familia);
write('imya='); readln(ftfon[i].abont.imya);
write('dolznost='); readln(ftfon[i].abont.rabota);
write('telefon='); readln(ftfon[i].ntfon);
write('nomer pomeshenia='); readln(ftfon[i].troom.nmb);
write('naimenovanie='); readln(ftfon[i].troom.name);
end;end;
procedure vivod;
begin
clrscr;
for i:=1 to n do
begin
writeln('zapis ',i);
writeln('familia=',ftfon[i].abont.familia);
writeln('imya=',ftfon[i].abont.imya);
writeln('dolznost=',ftfon[i].abont.rabota);
writeln('telefon=',ftfon[i].ntfon);
writeln('nomer pomeshenia=',ftfon[i].troom.nmb);
writeln('naimenovanie=',ftfon[i].troom.name);
end;end;
procedure poisk_po_telefonu;
begin
write('N telefona='); readln(nt);
for i:=1 to n do
if ftfon[i].ntfon=nt then
writeln('pomeshenie #',ftfon[i].troom.nmb,' ','abonenti=',ftfon[i].abont.familia,' ',ftfon[i].abont.imya);
readln;
end;
procedure poisk_po_pomesheniu;
begin
write('N pomeshenia='); readln(nt);
for i:=1 to n do
if ftfon[i].troom.nmb=nt then
writeln('Telefon #',ftfon[i].ntfon);
readln;
end;
procedure poisk_po_familii;
begin
write('Familia='); readln(na);
for i:=1 to n do
if ftfon[i].abont.familia=na then
writeln('Telefon #',ftfon[i].ntfon,' ','Pomeshenie #',ftfon[i].troom.nmb);
readln;
end;
procedure odnofamilci;
begin
for i:=1 to n do
begin
nt:=pos(' ',ftfon[i].abont.familia);
na:=copy(ftfon[i].abont.familia,1,length(ftfon[i].abont.familia)-nt-1);
t:=0;
for j:=i to n do
begin
if pos(na,ftfon[j].abont.familia)<>0 then
begin
inc(t);
writeln(ftfon[j].abont.familia,' ',ftfon[j].abont.imya);
end;
end;
readln;
end;end;
procedure insert;
begin
inc(n);
i:=n;
vvod;
end;
procedure delete;
begin
write('vvedite nomer zapisi'); readln(t);
for i:=t to n-1 do
begin
ftfon[i].abont.familia:=ftfon[i+1].abont.familia;
ftfon[i].abont.imya:=ftfon[i+1].abont.imya;
ftfon[i].abont.rabota:=ftfon[i+1].abont.rabota;
ftfon[i].ntfon:=ftfon[i+1].ntfon;
ftfon[i].troom.nmb:=ftfon[i+1].troom.nmb;
ftfon[i].troom.name:=ftfon[i+1].troom.name;
end;
dec(n);
end;
begin
n:=0;
repeat
clrscr;
writeln('1-vvod dannih');
writeln('2-poisk po nomeru telefona');
writeln('3-poisk po nomeru pomeshenia');
writeln('4-poisk po familii');
writeln('5-poisk odnofamilcev');
writeln('6-prosmotr');
writeln('7-insert');
writeln('8-delete');
writeln('9-exit');
readln(k);
if (k<>1) and (n=0) and (k<>9) then
begin clrscr; writeln('net daanih'); k:=1; end;
case k of
1:vvod;
2oisk_po_telefonu;
3oisk_po_pomesheniu;
4oisk_po_familii;
5dnofamilci;
6:vivod;
7:insert;
8elete;
end;
until k=9;
end.
Sos1 вне форума Ответить с цитированием
Старый 13.06.2010, 17:10   #4
L_Killer
Пользователь
 
Регистрация: 21.02.2010
Сообщений: 19
По умолчанию

Прикольно))) В коде смайлы выводит :D
L_Killer вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Блок схема dimonpwnz Помощь студентам 2 02.02.2010 16:16
Блок схема алгоритма программы и схема взаимодействия модулей. Lazio Фриланс 3 02.12.2009 23:10
Блок-схема((( Альбиша Помощь студентам 1 22.05.2009 18:01