Разработать меню для запуска программ — Pascal(Паскаль)

uses crt;
const n=10;
      nmax=1000;
type matr=array[1..n,1..n] of char;
     mas=array[1..nmax] of char;
procedure Pal;
var i:byte;
begin
clrscr;
writeln('Натуральное число называется палиндромом, если его запись читается');
writeln('одинаково и с начала и с конца. ');
writeln('Найти все числа-палиндромы, которые не превышают 100.');
for i:=1 to 99 do
if (i div 10=0)or (i mod 10 = i div 10) then write(i,' ');
readln;
end;
procedure AB(var mt:matr);
var i,j,ka,kb:byte;
begin
clrscr;
writeln('Дана символьная матрица порядка n. Вычислить количество букв "а" ');
writeln('над главной диагональю, количество букв "b" под побочной диагональю,');
writeln('и заменить в матрице эти буквы на символ "*" .');
readln;
writeln('Исходная матрица:');
for i:=1 to n do
  begin
    for j:=1 to n do
     begin
      mt[i,j]:=chr(ord(random(10)+97));
      if ((j>i)and(mt[i,j]='a'))
      or ((j>n-i+1)and(mt[i,j]='b'))then
        begin
          textcolor(12);
          write(mt[i,j]:3);
        end
      else
        begin
         textcolor(15);
         write(mt[i,j]:3);
        end;
      end;
     writeln;
  end;
ka:=0;kb:=0;
for i:=1 to n do
for j:=1 to n do
if (j>i)and(mt[i,j]='a') then
  begin
    ka:=ka+1;
    mt[i,j]:='*';
  end
else if (j>n-i+1)and(mt[i,j]='b') then
  begin
    kb:=kb+1;
    mt[i,j]:='*';
  end;
writeln('Izmenemnaya matrica:');
for i:=1 to n do
  begin
    for j:=1 to n do
    if mt[i,j]='*' then
      begin
        textcolor(12);
        write(mt[i,j]:3);
      end
    else
      begin
        textcolor(15);
        write(mt[i,j]:3);
      end;
     writeln;
    end;
writeln('Kolichestvo a=',ka);
writeln('Kolichestvo b=',kb);
readln
end;
procedure ABC(var m:mas;var k1,k2:integer);
var s:array[1..nmax] of char;
    x,i:integer;
begin
clrscr;
writeln('Дано натуральное число n, символы S1..Sn. Определить число вхождений');
writeln('в последовательность S1..Sn группы букв abc,aba');
repeat
write('x=');readln(x);
until (x>0)and(x<=nmax);
for i:=1 to x do
read(s[i]);
readln;
k1:=0;k2:=0;
for i:=1 to x-2 do
if (s[i]='a')and(s[i+1]='b')and(s[i+2]='c')then k1:=k1+1
else if (s[i]='a')and(s[i+1]='b')and(s[i+2]='a')then k2:=k2+1;
write('abc=',k1,' raz aba=',k2,' raz');
readln
end;
var a:matr;
    ms:mas;
    c,ka,kb:integer;
begin
clrscr;
randomize;
writeln('Нажмите Enter');
c:=0;
while c<4 do
  begin
    clrscr;
    writeln('Выберите программу:');
    writeln('1-числа-палиндромы до 100');
    writeln('2-символы a,b в матрице');
    writeln('3-подстроки abc,aba в массиве символов');
    writeln('4-Выход');
    readln(c);
    case c of
    1:Pal;
    2:AB(a);
    3:ABC(ms,ka,ka);
    4:exit;
    end;
  end;
readln
end.

Leave a Comment

2 + 6 =