Помогите преобразовать в подпрограммы!

[d1gma]

Дан вектор B[1:25]
а) найти произведение элементов в диапазоне [-3,3] и сумму положительных элементов.
б) удалить минимальный элемент вектора
в) заменить максимальный элемент вектора среднеарифметическим значением последних 15 элементов
г) поменять местами максимальные элементы из первых 10 и последних десяти элементов вектора

Program Lab8;
uses wincrt;
Var
B:Array[1..25] of Real;
k,i,Nmax,Nmax1,Nmax2,Nmin:Byte;
S,P,Sr,min,max,max1,max2,temp:Real;
Begin
Randomize;
WriteLn('Вектор B');
For i:=1 to 25 DO
Begin
B[i]:=40*Random-20;
Write(B[i]:6:2,' ');
If i mod 5=0 Then WriteLn('');
End;
WriteLn('');
P:=1;
For i:=1 to 25 DO
If(B[i]>=-3)and(B[i]<=3) Then P:=P*B[i];
S:=0;
For i:=1 to 25 DO
If(B[i]>0) Then S:=S+B[i];
WriteLn('Произведение эл-ов в диапазоне [-3,3] =',P:10:2);
WriteLn('Сумма положительных эл-ов =',S:10:2);
Nmin:=1;
min:=B[1];
For i:=2 to 25 DO
If B[i]max Then Begin max:=B[i];Nmax:=i;end;
WriteLn('max элемент массива=',max:6:2);
S:=0;
For i:=9 to 24 DO
S:=S+B[i];
Sr:=S/15;
WriteLn('Среднее арифметическое =',Sr:6:2);
B[Nmax]:=Sr;
WriteLn('Полученный вектор');
For i:=1 to 24 do
Begin
Write(B[i]:6:2,' ');
If i mod 5=0 Then writeln('');
End;
WriteLn('');
max1:=B[1];Nmax1:=1;
For i:=2 to 10 DO
If B[i]>max1 Then Begin max1:=B[i];Nmax1:=i;end;
WriteLn('max1 элемент массива=',max1:6:2);
max2:=B[15];Nmax2:=15;
For i:=15 to 24 DO
If B[i]>max2 Then Begin max2:=B[i];Nmax2:=i;end;
WriteLn('max2 элемент массива=',max2:6:2);
Temp:=B[Nmax1];B[Nmax1]:=B[Nmax2];B[Nmax2]:=Temp;
WriteLn('упорядоченный массив');
For i:=1 to 25 do
Begin
Write(B[i]:6:2,' ');
If i mod 5=0 Then WriteLn('');
End;
Writeln('');
End.

[min@y™]

Был бы я твоим преподом, с таким кодом отправлял бы на пересдачу, не глядя!
Ты всегда так проги пишешь? Читать же невозможно!

[Stilet]

Program Lab8;
uses wincrt;
Var
B:Array[1..25] of Real;
k,i,Nmax,Nmax1,Nmax2,Nmin:Byte;
S,P,Sr,min,max,max1,max2,temp:Real;

procedure uchi;
var i:integer;
Begin
 Randomize;
 WriteLn('Вектор B');
 For i:=1 to 25 DO Begin
  B[i]:=40*Random-20;
  Write(B[i]:6:2,' ');
  If i mod 5=0 Then WriteLn('');
 End;
 WriteLn('');
end;

procedure ni;
var i:integer; 
begin
 P:=1;
 For i:=1 to 25 DO If(B[i]>=-3)and(B[i]<=3) Then P:=P*B[i];
 S:=0;
 For i:=1 to 25 DO If(B[i]>0) Then S:=S+B[i];
 WriteLn('Произведение эл-ов в диапазоне [-3,3] =',P:10:2); 
 WriteLn('Сумма положительных эл-ов =',S:10:2);
end;

procedure san;
var i:integer;
begin
 Nmin:=1;
 min:=B[1];
 For i:=2 to 25 DO If B[i]max Then Begin max:=B[i];Nmax:=i;end;
 WriteLn('max элемент массива=',max:6:2);
 S:=0;
 For i:=9 to 24 DO S:=S+B[i];
  Sr:=S/15;
 WriteLn('Среднее арифметическое =',Sr:6:2);
 B[Nmax]:=Sr;
 WriteLn('Полученный вектор');
end;

procedure chi;
var i:integer;
begin
 For i:=1 to 24 do Begin
  Write(B[i]:6:2,' ');
  If i mod 5=0 Then writeln('');
End;
WriteLn('');
end; 

procedure go; var i:integer;
begin
 max1:=B[1];Nmax1:=1;
 For i:=2 to 10 DO If B[i]>max1 Then Begin max1:=B[i];Nmax1:=i;end;
 WriteLn('max1 элемент массива=',max1:6:2); 
 max2:=B[15];Nmax2:=15;
 For i:=15 to 24 DO If B[i]>max2 Then Begin max2:=B[i];Nmax2:=i;end;
 WriteLn('max2 элемент массива=',max2:6:2);
 Temp:=B[Nmax1];B[Nmax1]:=B[Nmax2];B[Nmax2]:=Temp; 
 WriteLn('упорядоченный массив');
end;

begin
ichi; ni; san chi; go; chi; readln;
End.

Устраивает.

[Vapaamies]

Сообщение от min@y™

Ты всегда так проги пишешь? Читать же невозможно!

Глядя на код Stilet-а, так и хочется сказать: а потом они вырастают и пробел перед вложенными блоками всё же появляется. Stilet, а насколько тебе надо вырасти до двух пробелов в блоках?

[Stilet]

а насколько тебе надо вырасти до двух пробелов в блоках?

Ну не знаю даже... Может под конец вселенной дорасту до камментов между блоками вместо пробела... Это чисто хвылософский вопрос )))
Сколько нужно Стилетов, чтоб вкрутить два пробела?

[min@y™]

Глядя на код Stilet-а, так и хочется сказать: а потом они вырастают и пробел перед вложенными блоками всё же появляется.

Хахаха, упал под стол!
Точно в десятку!

Вот, неужели так хуже:


Кстати, шрифт клёвый, совсем не напрягает глаза. Рекомендую.

[d1gma]

Спасибо огромное!!!

Извиняюсь за код, не моя работа, да и я не особо мастер.
вот более удобный на мой взгляд.

program Vektor;
uses crt;
var b,a:array[1..25] of real;
    n,i,imin,imax,imax1,imax2:integer;
    p,s,sr,t:real;
begin
clrscr;
randomize;
n:=25;
for i:=1 to n do
repeat
b[i]:=10*random-5;
until b[i]<>0;
writeln('Начальный');
for i:=1 to n do
write(b[i]:5:1);
writeln;
{1 punkt}
p:=1;s:=0;
for i:=1 to n do
 begin
  if (b[i]>=-3) and (b[i]<=3) then p:=p*b[i];
  if b[i]>0 then s:=s+b[i];
 end;
writeln('Сумма положительных элементов=',s:0:1);
writeln('Произведение=',p:0:1);
{2 punct}
imin:=1;
for i:=1 to n do
if b[i]<a[imin] then imin:=i;
writeln('Минимальный элемент=',b[imin]:0:1,' его номер=',imin);
for i:=imin to n-1 do
b[i]:=b[i+1];
n:=n-1;
writeln('Массив без минимального элемента:');
for i:=1 to n do
write(b[i]:5:1);
writeln;
{3 punkt}
sr:=0;
for i:=n-15 to n do
sr:=sr+b[i];
sr:=sr/15;
writeln('Среднeе последних 15 элементов=',sr:0:1);
imax:=1;
for i:=1 to n do
if b[i]>b[imax] then imax:=i;
writeln('Максимальный элемент=',b[imax]:0:1,'  его номер=',imax);
b[imax]:=sr;
writeln('Замена максимального элемента средним последних 15:');
for i:=1 to n do
write(b[i]:5:1);
writeln;
{4 punkt}
imax1:=1;
for i:=1 to 10 do
if b[i]>b[imax1] then imax1:=i;
writeln('Максимальный элемент из первых 10=',b[imax1]:0:1,'  его номер=',imax1);
imax2:=1;
for i:=n-10 to n do
if b[i]>b[imax2] then imax2:=i;
writeln('Максимальный элемент из первых 10=',b[imax2]:0:1,'  его номер=',imax2);
t:=b[imax1];
b[imax1]:=b[imax2];
b[imax2]:=t;
writeln('Обмен максимального из первых 10 и из последних 10:');
for i:=1 to n do
write(b[i]:5:1);
readln
end.

[Vapaamies]

Появление пробелов подтверждает мою гипотезу: d1gma растет прямо на глазах.

[min@y™]

d1gma растет прямо на глазах.

только оооооооооооооооооочень медленнннннннннннннооооооооооооооо. ........

[Stilet]

Вот, неужели так хуже:

Да не. Нормуль. )