В мене проблема потрібно здать завтра 14 задач.

[alex_fcsm]

const n=24;
type Tbag=record
      count:byte;
      netto:real;
      end;
      
var i,ind:integer;
    a:array[1..n] of TBag;
    
begin
for i:=1 to n do
 begin
  a[i].count:=random(4)+1;
  a[i].netto:=a[i].count*(random(1000)+100);
 end;
ind:=0;
for i:=1 to n do
 if a[i].count>2 then inc(ind);
writeln(ind, ' humans');
end.

[alex_fcsm]

uses crt;
var s,sub:string;
    i,n:integer;
    a:array[1..100] of string;

begin
clrscr;
writeln('Input str');
readln(s);
i:=0;n:=0;
repeat
inc(i);
if (s[i]=' ')and(s[i+1]<>' ') then begin
                   inc(n);
                   a[n]:=sub;
                   sub:='';
                   end
else if (s[i]<>' ')and(s[i]<>'.') then sub:=sub+s[i];
until i=length(s);
if sub<>'' then begin
inc(n);
a[n]:=sub;
end;
writeln;
for i:=1 to n do
 if length(a[i])=3 then writeln(a[i]);
end.

[alex_fcsm]

uses crt;
var s,sub:string;
    i,j,n:integer;
    a:array[1..100] of string;

begin
clrscr;
writeln('Input str');
readln(s);
i:=0;n:=0;
repeat
inc(i);
if (s[i]=' ')and(s[i+1]<>' ') then begin
                   inc(n);
                   a[n]:=sub;
                   sub:='';
                   end
else if (s[i]<>' ')and(s[i]<>'.') then sub:=sub+s[i];
until i=length(s);
if sub<>'' then begin
inc(n);
a[n]:=sub;
end;
writeln;
for i:=1 to n do
begin
 for j:=length(a[i]) downto 1 do
  write(a[i][j]);
 write(' ');
end;
end.

[alex_fcsm]

var s,sub:string;
    i:integer;
begin
readln(s);
sub:='';
for  i:=1 to length(s) do
  if s[i] in ['a'..'z','A'..'Z'] then begin
                                       if ord(UpCase(s[i]))=90 then sub:=sub+chr(65)
                                          else sub:=sub+chr(ord(UpCase(s[i]))+1);
                                      end
     else sub:=sub+s[i];
writeln(sub);
end.

[alex_fcsm]

10

uses crt;
const n=10;
type TPrint=record
      name:string;
      pages:integer;
      case typ:char of
        'b':(year:integer;author:string);
        'm':(date:string;sostav:string);
        'n':(red:string;dat:string)
     end;
var a:array[1..n] of TPrint;
    i:integer;

begin
for i:=1 to n do
 begin
  writeln('Input pages');
  readln(a[i].pages);
  writeln('Input name');
  readln(a[i].name);
  writeln('Input type(book-b,mag-m,news-n)');
  readln(a[i].typ);
  case a[i].typ of
  'b':begin
          writeln('Input year');
          readln(a[i].year);
          writeln('Input author');
          readln(a[i].author);
         end;
  'm': begin
          writeln('Input date');
          readln(a[i].date);
          writeln('Input sostav');
          readln(a[i].sostav);
         end;
  'n':begin
          writeln('Input redactor');
          readln(a[i].red);
          writeln('Input date');
          readln(a[i].dat);
         end;
   end;
 end;
clrscr;
for i:=1 to n do
 begin
  case a[i].typ of
  'b':begin
          writeln('Книга ');
          write(a[i].name,' ');
          write(a[i].year);
          write(a[i].author);
         end;
  'm': begin
          writeln('Журнал ');
          write(a[i].date,' ');
          write(a[i].sostav,' ');
         end;
  'n':begin
          writeln('Газета ');
          write(a[i].red,' ');
          write(a[i].dat,' ');
         end;
   end;
   write(a[i].pages,'стр.');
   writeln;
 end;


end.

[Кодер]

Спасибо, кое что и мне пригодилось )

[DiNis]

Тобі спасіба виручив

[Askar_g]

Zada4a 13 (похоже что уже не нужна)

uses crt;
var s:string;
    i,j:integer;
 begin
 clrscr;
  writeln('Vvedite text: ');
  readln(s);
  For i:=Length(s) downto 1 do
  write(s[i]);
 writeln;
 readkey;
 end.

[alex_fcsm]

Сообщение от Askar_g

Zada4a 13 (похоже что уже не нужна)

uses crt;
var s:string;
    i,j:integer;
 begin
 clrscr;
  writeln('Vvedite text: ');
  readln(s);
  For i:=Length(s) downto 1 do
  write(s[i]);
 writeln;
 readkey;
 end.

У Вас будет меняться порядок слов: 1 станет последним, 2 предпоследним и т.д.

[DiNis]

СпаСыБА Алекс