Помогите составить тексты программ на Turbo Pascal  
Кто чем может помогите

прог1.   Вычислить наибольший (наименьший) отрицательный элемент массива.
Пояснение: С клавиатуры вводится произвольный одномерный массив типа integer (не более 10 символов), после чего делается его контрольный вывод.
Переместите все положительные элементы массива в начало, а отрицательные в конец массива.

прог2.   Вычислить средней арифметический положительный (отрицательный) элемент каждой строки (столбца) матрицы.
Пояснение: Матрица 5X5 после чего делается её контрольный вывод. Поменять местами максимальный элемент заданной строки с минимальным элементом заданного столбца матрицы.

прог3.   Три точки заданы своими координатами (X1,X2), (Y1,Y2), (Z1,Z2) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой минимума.

прог4.   Определить наибольшее количество идущих подряд пробелов.

прог5.   Выбор студентов заданного пола, имеющих средний бал за сессию выше "4".
Пояснение: Даны пять записей, каждая из которых имеет 3 поля: группа, ФИО студента и оценка.

Заранее спасибо!    

reper
прог4

program test_string;
uses strings;
var
TestString:string;

function findMaxSpace(var toTest:string):byte;
const
max:byte=0;
current:byte=0;
var
i:byte;
begin
for i:= 1 to Length(toTest) do
 if toTest[i]=' ' then
                   inc(current)
                  else
                   if current>max then
                                   begin
                                    max:=current;
                                    current:=0
                                   end
                                  else current:=0;
FindMaxSpace:=max;
end;

BEGIN
readln(TestString);
writeln(findMaxSpace(TestString));
END.


Спасибо bestya
Ты меня выручил, а то меня препод достал, я их ему еще в марте обещал показать  
Теперь обрадую старика хотябы одной прогой  ::
Заходи почаще, у меня всегда много вопросов  
Когда делать будет нечего, попробуй с другими прогами поработать! Я тебе тоже помогу чем смогу, обращайся если че
 

Да, кстате вопрос такой: почему некоторые программы не срабатывают хотя нет ошибок!!!  
Например:

program Example_63;
uses crt,graph;
const a=-70;b=70; n=70;as=1;

var gd,gm,i,k:integer;
t1,t2,h,m:real;
x0,x1,y0,y1:word;
s3,s4:string;
function f(x:real):real;
begin
if x<>0 then f:=cos(x)/X;
end;
procedure grafun(x0,x1,y0,y1,n:word; a,b:real);
var x:real;
   i,u,v,xv,yv:word;
   s1,s2,as1:string;
begin

xv:=round(x0-a*t1); yv:=round((y0+y1)/2);
  setcolor(11); rectangle(x0,y0,x0+1,y1);
  rectangle(x0,y1+1,x1,y1);
  str(a:1:1,s1);str(b:1:1,s2);
  setcolor(11);
  line(x0,y0,x0-5,y0+5);
  line(x0+1,y0,x0+6,y0+5);
  line(x1,y1,x1-5,y1-5);
  line(x1,y1+1,x1-5,y1+6);
  setcolor(10);
  outtextxy(x0+8,y0,'F(бЁ« )');
  outtextxy(x1-50,y1-15,'m(¬ бб )');
  moveto(x0,yv-round(f(a)*t2));
  SETCOLOR(13);
  for i:=1 to 10 do
  begin
  line(x0+i*20,y0+20,x0+i*20,y1+5);
   line(x0-5,y1-18*i,x1-20,y1-18*i);
  end;
  setcolor(10);
  for i:=1 to n do
  begin
    x:=a+i*h; u:=x0+round((x-a)*t1);
    v:=yv-round(f(x)*t2); lineto(u,v);
  end;
end;
begin
k:=1;
clrscr;
write('vedi a=');
{readln(a);
writeln;
write('vedi b=');
readln(b );
writeln;
write('vedi n=');
readln(n);   }
i:=0;
Initgraph(i,i,'g:\bgi');
x0:=50;x1:=285;y0:=240;y1:=470;{a:=-10;b:=10; }
setfillstyle(1,4); bar(x0-10,y0-10,x1+10,y1+10);
h:=(b-a)/n;
  m:=abs(f(a));
  for i:=1 to n do if m<abs(f(a+i*h)) then m:=abs(f(a+i*h));
   str(m:1:1,s3);str(-m:1:1,s4);
   setcolor(10);
{  outtextxy(x0,y0,s3);
  outtextxy(x1,y0,s4); }
  t1:=(x1-x0)/(b-a); t2:=(y1-y0)/(2*m);
{for k:=1 to 8 do
begin}

grafun(x0,x1,y0,y1,b,a,n);
{a1:=a1+0.5;f(a1,a);
end;}

repeat until keypressed;
closegraph;
end.

reper

Цитировать

Код Выделить Развернуть

Initgraph(i,i,'g:\bgi');

'g:\bgi' это должен быть правильный путь до файла "EGAVGA.BGI",
попробуй замени на '' и скопируй файл EGAVGA.BGI в папку с откомпилированной программой или пропиши правильный путь.

bestya помоги разобраться с прогам
чего не хватает в прог №1  
№1
for i:=1 to n do begin
if a<min then min:=a;
if a>max them max:=a;
end;
{поиск максимума\минимума}

i:=1; j:=n; {n-кол-во эл-тов}
repeat
n:=0;
if a>0 then begin n:=n+1; i:=i+1; end;
if a[j]<0 then begin n:=n+1; j:=j-1; end;
if n=0 then begin x:=a; a:=a[j]; a[j]:=x; i:=i+1; j:=j-1; end;
until i<j;
for i:=1 to n do wrieln(a); {вывод упорядоxенного массива}

  А вот и прог №4 только в другом варианте
но почемуто  прога не работает (она вообще будет работать? Что надо изменить?)

№4

var s:string;
i,j,max:chortint;
begin

j:=0; max:=0;
for i:=1 to s[0] do begin {s[0] первый байт строки в котором храниться дилна}
if ord(s)=32 then j:=j+1; {32 - код пробела в 10 кодировке}
if (ord(s)<>32)and(j>max) then begin max:=j; j:=0;end;
end;
readkey; end.

Как мне быть с другими прогами  
Помогите мне пожалуйста  

№1

uses crt;

type
arr=array [1..10] of integer;

const
n:byte=10;
max:integer=0;
min:integer=0;
a:arr=(-2,-3,4,-1,2,-3,3,-89,2,-45);

var
i,j:byte;
x:integer;

BEGIN
clrScr;

for i:=1 to n do
 begin
  if a[i]<min then min:=a[i];
  if a[i]>max then max:=a[i];
 end;

writeln('min=',min,' max=',max);

for i:=1 to 10 do write(a[i],' ');

WriteLn;

i:=1;
j:=n;

while i<j do
 begin
  if a[i]>=0 then inc(i)
             else
              begin
               x:=a[j];
               a[j]:=a[i];
               a[i]:=x;
               dec(j);
               if i<>1 then dec(i);
              end;

 end;

for i:=1 to 10 do write(a[i],' ');
END.


на ввод массива с клавиатуры, надеюсь переделаешь сам

№4

Цитироватьi,j,max:chortint;

скорее всего должно быть byte поскольку Shortint -128..127, а если у тебя в строке пробелов будет больше чем 127?


uses crt; {если используешь внешние функции, по не забывай подключать модули}
var
s:string;{Да и почему в программе у тебя нет ввода этой переменной?}
i,j,max:byte;

begin
j:=0; max:=0;
readln(s);{вводим строку с клавиатуры}
for i:=1 to length(s) do
  begin
    {s[0] первый байт строки в котором храниться дилна}
    {лучше используй фунцию length, наглядние и понятнее будет}
    {иногда стоит использовать не только конструкцию if ... then , но и if  ...  then ...  else}
   
    if ord(s[i])=32 then j:=j+1 {32 - код пробела в 10 кодировке}
                           else
                             if j>max then
                                            begin
                                              max:=j;
                                              j:=0;
                                            end
                                          else j:=0;
  end;
writeln(max);
readkey;
end.



Используй отступы и пробелы, что бы проги были более наглядные и их проще было читать.

P.S. и начни наконец сам изучать язык, а то на экзамене препод все равно завалит

Вот тебе первая прога:
program Prog1;
 uses CRT;
 var Arr : array [1..10] of integer;
     i, j, count, temp, min, max : integer;
     FlagMin, FlagMax : boolean;

BEGIN
 ClrScr;
 FlagMin := false;
 FlagMax := false;
 repeat
   Write('Размер массива > ');
   ReadLn(count);
 until (count > 0) and (count <= 10);
 for i:=1 to count do
 begin
   Write(i, '-й элемент массива > ');
   ReadLn(Arr[i]);
 end;
 Write('Исходный массив :');
 for i:=1 to count do Write(' ', Arr[i]);
 WriteLn;

 {Сортировка методом пузырька}
 for i:=2 to count do
   for j:=count downto i do
     if Arr[j-1] < Arr[j] then
     begin
       temp := Arr[j-1];
       Arr[j-1] := Arr[j];
       Arr[j] := temp;
     end;

 Write('Отсортированный массив :');
 for i:=1 to count do Write(' ', Arr[i]);
 WriteLn;

 if Arr[count] < 0 then
 begin
   min := Arr[count];
   FlagMin := true;
 end;
 if Arr[1] < 0 then
 begin
   max := Arr[1];
   FlagMax := true;
 end;
 for i:=2 to count do
   if (Arr[i] < 0) and (Arr[i-1] >= 0) then
   begin
     max := Arr[i];
     FlagMax := true;
   end;

 if FlagMin then WriteLn('Минимальный отрицательный элемент : ', min)
   else WriteLn('Минимального отрицательного элемента не существует');
 if FlagMax then WriteLn('Максимальный отрицательный элемент : ', max)
   else WriteLn('Максимального отрицательного элемента не существует');
END.

И еще, поставь корректно условия задач, тогда может быть чем-то еще помогу.

Цитировать
прог3. Три точки заданы своими координатами (X1,X2), (Y1,Y2), (Z1,Z2) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой минимума.

Бессвязный поток слов, объясни.
Добавлено:
О, первая прога у тебя уже есть, ну да ладно...

Обращение к bestya:
Спасибо за помощь
С четвертой прогой я разобрался!
Ну а на счет проги №1 не совсем ясно.

Ну а тебе Twizzted вопрос (в общем он для всех)
Запускаю значит я программу над которой ты трудился!
И вроде бы все нормально, но после ввода элементов массива программа прекращает свою работу
Чего ей еще не хватает?

Да, кстати bestya я уже второй месяц продолжаю пролистывать учебник Фаронова В.В. Turbo Pascal 7.0.
А ты бы, какой учебник посоветовал?

Так, я чуть не забыл! В проге №3 .........с точкой, минимальный. В смысле:

прог3. Три точки заданы своими координатами (X1,X2), (Y1,Y2), (Z1,Z2) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой, минимальный.
Как теперь? Возможно решить?  

Хочу сказать еще немного о проге №3
Понятнее будет сказано так:

прог3. Три точки заданы своими координатами  А(X1,У1), В(Х2,Y2), С(Х3,У3) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой, минимальный.

Теперь все понятно!!!