5.4 Сложные варианты

Задача 1. Определить, является введенное слово "перевертышем" (потоп, казак).

USES Crt;

VAR

A, B : STRING [20]; I, N: BYTE;

BEGIN

ClrScr;

Write('Введите слово '); ReadLn(A);

N:=Length(A);

FOR I:=N DownTo 1 DO

B:=B+A[I];

IF B=A THEN Write('Перевертыш') ELSE Write('Не перевертыш');

END.

Задача 2. Подсчитать количество слов, в которых буква "а" входит не менее двух раз. (слова разделены пробелом).

USES Crt;

VAR

A : STRING [255]; KS, KB, I, N : INTEGER;

BEGIN

ClrScr;

WriteLn('Введите текст '); ReadLn(A);

A:=A+' ';

N:=Length(A);

KB:=0; KS:=0; I:=1;

While (I<=N) DO Begin

While (A[I]<>' ') DO Begin

IF (A[I]='a') OR (A[I]='A') THEN KB:=KB+1;

I:=I+1;

End;

IF KB>2 THEN KS:=KS+1;

KB:=0;

I:=I+1;

End;

WriteLn(' Количество слов, в которых буква "а" встречается не менее двух раз = ',ks)

END.

Задача 3. Найти слово в тексте, содержащее наибольшее количество букв "м".

USES Crt;

VAR

A, D : STRING [255]; I, KB, MKB, K, MK, NP, MNP : INTEGER;

BEGIN

ClrScr;

WriteLn('Введите текст'); ReadLn(A);

I:=1; KB:=0; MKB:=0; NP:=1;

While(I<=Length(A)) DO Begin

While(A[I]<>' ') DO Begin

IF A[I]='м' THEN KB:=KB+1;

K:=K+1; I:=I+1;

End;

IF MKB<KB THEN Begin MKB:=KB; MNP:=NP; MK:=K; End;

NP:=I+1; KB:=0; K:=0;

I:=I+1;

End;

D:=Copy(A,MNP,MK);

WriteLn('Слово с максимальным количеством букв "м" - ',D);

END.

Задача 4. Проверить правильность написания круглых скобок.

Var

A:String[50];

K,I,N:Integer;

BEGIN

WriteLn(‘Введите тест’);

ReadLn(A);

N:=Length(A);

FOR I:=1 TO N DO Begin

IF A[I]=’(‘ THEN=N+1;

IF A[I]=’)‘ THEN N:=N-1;

IF N<0 THEN Begin WriteLn(‘Неверно’); Break; End;

End;

IF N=0 THEN WriteLn(‘Верно’) ELSE WriteLn(‘Неверно’);

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Вывести на экран самое длинное слово из введенного текста.

2. Определить, имеются ли в строке символов все буквы, входящие в введенное слово.

3. Из текста удалить все слова, начинающиеся и оканчивающиеся на одну и ту же букву.

4. В тексте найти и подсчитать количество слов, у которых первый и последний символы совпадают между собой (слова разделены пробелами).

6. Создание графических изображений. Модуль Graph

Задача 1. Построить различные геометрические фигуры.

Uses Graph, Crt;

VAR

Gd,Gm : INTEGER;

Radius, I, Width, K : INTEGER;

Y0, Y1, Y2, X1, X2 : INTEGER;

Pattern : FillPatternType;

Points : ARRAY[1..6] OF PointType;

BEGIN

Gd:=vga; Gm:=1;

{ Инициализация графического режима }

InitGraph(Gd,Gm,'C:\tp7\bgi'); IF GraphResult<>0 THEN HALT(1);

SetBkColor(0); SetColor(2); {Цвет фона и изображения}

I:=0;

FOR Radius:=1 TO 5 DO Begin {Построение окружностей }

SetColor(Radius+4);

Circle(150,150,Radius*25);

Inc(I); IF I=4 THEN I:=0;

End;

ReadLn;

ClearDevice; SetBkColor(1); SetColor(5); SetLineStyle(0,0,3);

Ellipse(130,130,0,360,30,50); {эллипс}

ReadLn;

ClearDevice; SetColor(4); Ellipse(130,130,0,180,100,70); { эллиптическая дуга}

ReadLn;

ClearDevice; K:=4;

FOR Radius:=1 TO 5 DO Begin

SetColor(K);

Arc(300,100,0,90,Radius*20); {дуги}

Inc(K);

end;

ReadLn;

ClearDevice; Width:=20; SetColor(1); SetBkColor(11);

FOR I:=1 TO 5 DO Begin

SetFillStyle(7,I+4); {определение стиля заполнения}

Bar(I*Width,I*20,Succ(I)*Width,200); {построение прямоугольников}

end;

SetFillStyle(5,12); Bar(150,150,250,250);

ReadLn;

{Построение параллелепипеда с верхней плоскостью}

SetFillStyle(8,4); ClearDevice;

Y1:=100; Y2:=200; X1:=230; X2:=300;

SetLineStyle(3,0,3); {Определение стиля линии}

Bar3d(x1,y1,x2,y2,10,topon);

ReadLn;

{Построение параллелепипеда без верхней плоскости}

ClearDevice;

SetLineStyle(0,0,1); setfillstyle(11,1); bar3d(x1,y1,x2,y2,10,topoff);

ReadLn;

{Пользовательский шаблон заполнения}

CleardDevice; SetColor(6); SetLineStyle(0,0,3); { Стиль линии}

{заполнение массива}

Pattern[1]:=31; Pattern[2]:=62; Pattern[3]:=124; Pattern[4]:=248;

Pattern[5]:=124; Pattern[6]:=62; Pattern[7]:=31; Pattern[8]:=0;

SetFillPattern(pattern,12); {Задание шаблона пользователя}

Bar(10,10,GetMaxX Div 2,GetMaxY Div 2);

Rectangle(10,10,GetMaxX Div 2,GetMaxY Div 2);

ReadLn;

{Построение закрашенного сектора эллипса}

ClearDevice; SetBkColor(3); SetColor(4); SetFillStyle(7,14);

Sector(100,100,0,90,50,70);

ReadLn;

ClearDevice; SetFillStyle(1,14); {Построение закрашенного сектора круга}

Pieslice(150,150,90,360,100);

ReadLn;

{Построение эллипса, заполненного текущим цветом}

ClearDevice; SetFillStyle(6,13); SetLineStyle(3,0,1);

FillEllipse(200,200,50,100);

ReadLn;

{Построение закрашенного многоугольника}

ClearDevice; Randomize; SetLineStyle(0,0,1); SetFillStyle(11,1);

{Определение случайных координат вершин}

FOR I:=1 TO 5 DO Begin

Points[I].X:=Random(GetMaxX); Points[I].Y:=Random(GetMaxY);

End;

Points[6].X:=Points[1].Y; Points[6].Y:=Points[1].Y;

Fillpoly(6,Points);

ReadLn;

CloseGraph;

END.

Задача 2. Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран: красит экран в белый и черный цвет; термометр, у которого ртутный столбик поднимается; термометр, у которого ртутный столбик опускается.

USES Graph, Crt;

VAR

Dr, Md, M, X, Y, I : INTEGER; Ch:CHAR;

BEGIN

Dr:=Detect;

InitGraph(Dr,Md,'c:\tp7\bgi'); IF GraphResult<>0 then HALT(1);

REPEAT

SetBkColor(1); SetColor(6); SetTextStyle(0,0,2);

ClearDevice;

{ Вывод меню }

OutTextXY(50,140,'Пробел - Красим экран');

OutTextXY(50,170,'Стрелка вверх - Столбик поднимается');

OutTextXY(50,200,'Стрелка вниз - Столбик опускается');

OutTextXY(50,230,'ESC - Выход');

REPEAT

Ch:=ReadKey; {разветвление программы по нажатию клавиши}

CASE Ch OF

#32:Begin { Красим экран }

ClearDevice;

SetBkColor(0); SetFillStyle(1,15);

Bar(0,0,GetMaxX div 2,GetMaxY);

SetFillStyle(1,0);

Bar(GetMaxX div 2,0,GetMaxX,GetMaxY);

OutTextXY(70,GetMaxY-25,'Нажмите DEL');

End;

#72:Begin { Ртутный столбик поднимается }

ClearDevice; SetLineStyle(0,0,1); SetBkColor(1); SetColor(4);

X:=GetMaxX div 2; Y:=GetMaxY div 2;

Rectangle(X,Y,X+40,GetMaxY-20);

FOR I:=1 TO120 DO Begin

SetColor(4); SetLineStyle(0,0,3);

Line(X,GetMaxY-20-I,X+40,GetMaxY-20-i);

Delay(250);

End;

OutTextXY(70,GetMaxY-25,'Нажмите DEL');

End;

#80:Begin { Ртутный столбик опускается }

ClearDevice; SetLineStyle(0,0,1); SetBkColor(1); SetColor(4);

X:=GetMaxX div 2; Y:=GetMaxY div 2;

Rectangle(x,y,x+40,GetMaxY-20);

SetFillStyle(1,4);

Bar(x,GetMaxY-140,x+40,GetMaxY-20);

FOR I:=1 TO 117 DO Begin

SetColor(1); SetLineStyle(0,0,3);

Line(x+1,GetMaxY-140+i,x+39,GetMaxY-140+i);

Delay(250);

End;

SetColor(4); OutTextXY(70,GetMaxY-25,'Нажмите DEL');

End;

End;

UNTIL (Ch=#83) or (Ch=#27);

UNTIL (Ch=#27);

CloseGraph;

END.

Задача 3. Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран день и ночь.

USES Crt,Graph;

LABEL Ex,New;

VAR Gd,Gm : INTEGER; Av: CHAR;

PROCEDURE DAY; {процедура-солнечное затмение}

VAR X,Y,X1,Y1 : INTEGER; U: REAL;

BEGIN

ClearDevice; SetFillStyle(1,14); SetColor(14);

X:=GetMaxX DIV 2; Y:=GetMaxY DIV 2;

FillEllipse(X,Y,50,50); {солнце}

FOR Gm:=1 TO 150 DO Begin

U:=Random(359);

X1:=Trunc(Random (200)*COS(U))+X; Y1:= Trunc (Random (200)*SIN(U))+Y;

Line(X,Y,X1,Y1); {солнечные лучи}

End;

SetFillStyle(1,8); SetColor(8);

FillEllipse(X-15,Y,50,50); {тень луны}

REPEAT

UNTIL KeyPressed; {задержка до нажатия любой клавиши}

END;

PROCEDURE NOCH; {процедура - лунная ночь со звездами}

VAR R,X,Y,I:INTEGER;

BEGIN

ClearDevice; SetFillStyle (1,15); SetColor (15);

FOR I:=1 TO 50 DO Begin

R:= Random (2);

PutPixel(Random (GetMaxX), Random (GetMaxY),15);

PutPixel(Random (GetMaxX), Random (GetMaxY),15);

FillEllipse(Random (GetMaxX), Random (GetMaxY),R,R);

End;

SetFillStyle (1,15); SetColor (15); FillEllipse (200,100,50,50);

SetFillStyle (1,0); SetColor (0); FillEllipse (180,100,50,50); {луна}

REPEAT

UNTIL KeyPressed; {задержка до нажатия любой клавиши}

END;

BEGIN{основная программа}

Gd:=Detect; InitGraph(Gd,Gm,'C:\tp7\BGI');

WHILE true DO Begin

SetFillStyle (1,1); FloodFill(10,10,1); SetFillStyle (1,0);

Bar(215,115,415,365);

SetColor (5); SetFillStyle (1,5);

Bar(200,100,400,350);{меню}

SetTextStyle(7,0,5); SetColor (0);

OutTextXY(237,117,'MENU'); OutTextXY (237,287,'EXIT');

SetColor (12); OutTextXY (235,115,'MENU');

SetColor (4); OutTextXY (235,285,'EXIT');

SetTextStyle (0,0,3); SetColor (0);

OutTextXY (227,207,'D:ДЕНЬ'); OutTextXY (227,247,'N:НОЧЬ');

SetColor (3); OutTextXY (225,205,'D:ДЕНЬ'); OutTextXY (225,245,'N:НОЧЬ');

SetColor (15); SetTextStyle (0,0,2);

OutTextXY (100,450,'использовать клавиши D,N,ESC');

Av:=ReadKey;

CASE Av OF {разветвление программы по нажатию клавиши}

'D','d' : DAY;

'N','n' : NOCH;

CHR(27) : GOTO Ex;

End;

End;

Ex: CloseGraph;

END.

Задача 4. Построить график функции.

USES Crt, Graph;

VAR

Gd, Gm : INTEGER;

X0, Y0 : INTEGER; { Начало осей координат }

X, Y : INTEGER; Mx, My, I : INTEGER;

A, B, H, F : REAL;

BEGIN

WriteLn('Введите интервал и шаг изменения функции'); ReadLn(A,B,H);

WriteLn('Введите масштаб по X и Y'); ReadLn(Mx,My);

Gd:=Detect; Gm:=1;

InitGraph(Gd,Gm,'c:\tp7\bgi'); IF GraphResult<>0 THEN HALT(1);

{ Построение осей координат }

X0:=GetMaxX div 2; Y0:=GetMaxY div 2;

Line(10,Y0,GetMaxX,Y0); Line(X0,10,X0,GetMaxY);

{ Построение стрелок }

Line(X0,10,X0-10,20); Line(X0,10,X0+10,20);

Line(GetMaxX,Y0,GetMaxX-10,Y0-10);

Line(GetMaxX,Y0,GetMaxX-10,Y0+10);

OutTextXY(X0-25,10,'X'); OutTextXY(GetMaxX-20,Y0+20,'Y');

{ Разметка осей координат }

I:=X0;

REPEAT

I:=I+Mx;

PutPixel(I,Y0-1,15); PutPixel(2*X0-I,Y0-1,15);

UNTIL I>GetMaxX;

I:=Y0;

REPEAT

I:=I+My;

PutPixel(X0+1,I,15); PutPixel(X0+1,2*Y0-I,15);

UNTIL I>GetMaxY;

{ Построение графика функции }

REPEAT

F:=A*A; { функция }

X:=Trunc(X0+A*Mx); Y:=Trunc(Y0-F*My);

PutPixel(X,Y,15); A:=A+H;

UNTIL A>B;

ReadLn;

END.

Задача 5. Построить круговую диаграмму.

USES Сrt,Graph;

VAR

Gd, Gm : INTEGER; I,N,S,C: INTEGER;

M : ARRAY[1..10] OF INTEGER;

Nk, Kk : INTEGER; P:REAL;

BEGIN

WriteLn('Введите количество значений'); ReadLn(N);

S:=0;

FOR I:=1 TO N DO Begin

Writeln('Введите ',I,' значение'); ReadLn(M[I]);

S:=S+M[I];

end;

P:=360/S; {приходится радиан на 1% }

Gd:=Detect; Gm:=1;

InitGraph(Gd,Gm,'c:\tp7\bgi'); IF GraphResult<>0 THEN HALT(1);

S:=0; C:=1;

FOR I:=1 TO N DO Begin

Nk:=Trunc(P*S); { Начальный угол }

Kk:=Trunc(P*(S+M[I])); { Конечный угол }

SetFillStyle(1,C);

PieSlice(GetMaxX div 2,GetMaxY div 2,nk,kk,100);

S:=S+m[i];

C:=C+1; IF C=14 THEN C:=1; { Изменение цвета }

End;

ReadLn;

CloseGraph;

END.

Задача 6. Построить пятиконечную звезду.

USES Crt,Graph;

VAR

Gd,Gm : INETEGER; X,Y,Rb,Rm : INETEGER;

Points: ARRAY [1..11] OF PointType; {Массив вершин }

I, A : REAL;

BEGIN

Gd:=Detect; Gm:=1;

InitGraph(Gd,Gm,'c:\tp7\bgi'); IF GraphResult<>0 THEN HALT(1);

Rb:=150; Rm:=70;

ClearDevice; SetBkColor(3); SetColor(4); SetFillStyle(1,4);

I:=1; A:=0.94;

{ Определение координат вершин звезды }

WHILE (I<=10) DO Begin

X:=Trunc(Rb*COS(A))+300; Points[I].X:=X;

Y:=Trunc(Rb*SIN(A))+200; Points[I].Y:=Y;

Inc(I); A:=A+0.628;

X:=Trunc(Rm*COS(A))+300; Points[I].X:=X;

Y:=Trunc(RM*SIN(A))+200; Points[I].Y:=Y;

Inc(I); A:=A+0.628;

End;

{ Связь координат первой и последней вершин }

Points[11].X:=Points[1].X; Points[11].Y:=Points[1].Y;

FillPoly(11,Points); { Построение звезды }

ReadLn;

CloseGraph;

END.

Задача 7. Построить объект, который передвигается с помощью навигационных клавиш.

USES Crt,Graph;

VAR

Gd,Gm : INTEGER; Av : CHAR;

X,Y,I,T,Z,K : INTEGER; St : STRING[225];

BEGIN

Gd:=Detect; InitGraph(Gd,Gm,'C:\tp7\BGI');

ClearDevice;

X:=GetMaxX DIV 2; Y:=GetMaxY DIV 2;

T:=0; I:=0; K:=500;

REPEAT

SetColor(15);

{ Построение объекта }

Line(X,Y-10,X,Y-3); Line (X,Y+10,X,Y+3);

Line (X-10,Y,X-3,Y); Line (X+10,Y,X+3,Y);

Circle(X,Y,7);

Av:=ReadDKey;

{ Изменение координат при нажатии клавиши }

IF CHR(75)=Av THEN T:=-10; IF CHR(77)=Av THEN T:=10;

IF CHR(72)=Av THEN I:=-10; IF CHR(80)=Av THEN I:=10;

SetColor (0);

Line (X,Y-10,X,Y-3); Line (X,Y+10,X,Y+3);

Line (X-10,Y,X-3,Y); Line (X+10,Y,X+3,Y);

Circle(X,Y,7);

X:=X+T; Y:=Y+I; I:=0; T:=0;

IF X>(GetMaxX-2) THEN X:=GetMaxX-2; IF X<2 THEN X:=2;

IF Y>(GetMaxY-2) THEN Y:=GetMaxY-2; IF Y<2 THEN Y:=2;

UNTIL ORD(Av)=27; { Пока не нажата клавиша Esc }

END.

Задача 8. Построить орнамент.

USES Crt, Graph;

VAR

Gd,Gm : INTEGER; Av : CHAR;

X1, Y1, X, Y : INTEGER; U, H : REAL;

BEGIN

Gd:=Detect; InitGraph(Gd,Gm,'C:\tp7\BGI');

SetFillStyle(1,14); SetBkColor(5); SetColor(14);

X:=GetMaxX DIV 2; Y:=GetMaxY DIV 2;

U:=2*Pi;

While U>=0 DO Begin

X1:=Trunc(100*COS(U))+X; Y1:=Tunc(100*SIN(U))+Y;

Circle(X1,Y1,3);

Delay(1000); U:=U-0.1;

End;

H:=-5;

While H<=45 DO Begin

X:=Trunc(100+H*10); Y:=Trunc(100-SIN(H)*10);

Circle(X,Y,2);

Delay(500); H:=H+0.5;

End;

H:=-5;

While H<=45 DO Begin

X:=Trunc(100+H*10); Y:=Trunc(380-SIN(H)*10);

Circle(X,Y,2);

Delay(500); H:=H+0.5;

End;

ReadLn;

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Построить семейство одинаковых окружностей, центры которых лежат на окружности большего диаметра.

2. По периметру экрана построить семейство разноцветных квадратов, а в середине – множество разноцветных точек.

3. Построить движущиеся изображения двух прямоугольников и круга, на которых помещены слова из фразы “ КТО СКАЗАЛ МЯУ?”.

4. Построить движущиеся НЛО на фоне звездного неба.

5. Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран круг, квадрат или треугольник.