плз решите задачи по ПАСКАЛЮ!

[Азарт]

. Дана последовательность из положительных и отрицательных элементов. Получить новую последовательность, элементами которой являются индексы отрицательных элементов исходящей последовательности.

2. Дана последовательность целых положительных чисел. Найти произведения только тех из них, который больше заданного числа М. если таких чисел нет, то выдать сообщение об этом.

3. Cоставьте прогу, которая по заданному году и номеру месяца m определяет количество дней в этом месяце. (тока через case надо)

4. Составьте программу подсчёта числа одинаковых букв, стоящих на одних и тех же местах в словах Х и У.

5. Ввести строку. На печать выдать новую строку, в которой первое и последнее слова поменять местами.

[Костя КС]

1

program qq;
const n=10;
var
a : array[1..n] of real;
b : array[1..n] of byte;
i,k : byte;
begin
k:=0;
for  i:=1 to n do
  begin
  write('a[',i,']= ');
  read(a[i]);
    if a[i]<0 then
    begin
     k:=k+1;
     b[k]:=i;
    end;
    end;
writeln(' ');
write('b = ');
for i:=1 to k do write(' ',b[i]);
  end.

[Костя КС]

3

program qq;
const
a : array[1..12] of integer=(31,28,31,30,31,30,31,31,30,31,30,31);
var
g,m : integer;

begin
write('год: ');
readln(g);
write('месяц: ');
readln(m);

case m of
 1,3..12 : writeln(a[m]);
 2 : if (m=2)and(g mod 4 = 0) then writeln(a[m]+1,' дней')
      else writeln(a[m],' дней');
 end;
end.

[Азарт]

спс за задачи)

[Костя КС]

2

program qq;
const n = 10;
var
a : array[1..n] of integer;
p,m : integer;
i : byte;

begin
write('m= ');
readln(m);
p := 1;
for i:=1 to n do
  begin
  write('a[i',i,']= ');
  readln(a[i]);
  if a[i]>m then p:= p*a[i];
  end;
 if p<>1 then writeln('произведение = ',p)
   else  writeln('нет чисел');
end.

спасибо к репутации не добавляется)

[Азарт]

а как те репутацию повысить? я сделаю

[bear12345]

Костя КС,проверь пожалуйста мои задачи http://www.programmersforum.ru/showthread.php?t=43612 .Они уже готовые,просто проверь.я в 1-ой сомневаюсь.проверь хотя бы её,она короткая.

[IT-man]

4

program stroki;

var
s,s1 : string;
k,i:integer;

begin
k:=0;
write('1-e slovo: ');
readln(s);
write('2-e slovo: ');
readln(s1);
for i:=1 to length(s) do
if s[i]=s1[i] then inc(k);
writeln(k);
readln;
end.

[Костя КС]

5

program qq5;
var
s, s1, s2 : string;
begin
readln(s);
 s1:= s;
 s2:= s;
 
 delete(s1,pos(' ',s1),length(s1));
 repeat
 delete(s2,1,pos(' ',s2));
 until pos(' ',s2) = 0;

 delete(s,1,length(s1));
 delete(s,length(s)-length(s2),length(s));
 
 writeln(s2,s,' ',s1);
 end.

репутация.
внизу под именем три маленьких картинки, по-моему с весами которая.

[Азарт]

спс всем кто делал задачи. я репутацию сделал всем)