Паскаль. Сборник задач по программированию на языке Паскаль Автор Селезнева Наталья Николаевна, учитель информатики и икт моу
 Скачать 350.82 Kb.
|
|
4.2.4 Алгоритмы удаления, вставки и перестановки элементов Задача 1. Дан двумерный массив размерностью 8х7, заполненный случайным образом. • Поменять местами средние строки с первой и последней. • Вставить между средними строками первую строку. • Удалить все столбцы, в которых первый элемент больше последнего. • Заменить все элементы первых трех столбцов на их квадраты. USES Crt; VAR A:ARRAY[0..8,0..7] OF INTEGER; A1:ARRAY[0..9,0..7] OF INTEGER; A2:ARRAY[0..8,0..7] OF INTEGER; I,J,K:BYTE; PP:INTEGER; BEGIN ClrScr; Randomize; { Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы } WriteLn(' Значения элементов двумерного массива'); FOR I:=1 TO 8 DO Begin FOR J:=1 TO 7 DO Begin A[I,J]:=Random(15); Write(A[I,J]:3); End; WriteLn; End; WriteLn; { 1. Поменять местами строки } WriteLn(' Средние строки поменялись местами с первой и последней'); FOR J:=1 TO 7 DO Begin PP:=A[1,J]; A[1,J]:=A[4,J]; A[4,J]:=PP; PP:=A[5,J]; A[5,J]:=A[8,J]; A[8,J]:=PP; End; { Вывод измененного массива } FOR I:=1 TO 8 DO Begin FOR J:=1 TO 7 DO Write(A[I,J]:3); WriteLn; End; ReadLn; { 2. Вставка } WriteLn(' Первая строка вставлена между средними строками'); K:=0; FOR I:=1 TO 8 DO Begin Inc(K); FOR J:=1 TO 7 DO Begin A1[K,J]:=A[I,J]; Write(A1[K,J]:3); End; WriteLn; IF I=4 THEN Begin Inc(K); FOR J:=1 TO 7 DO Begin A1[K,J]:=A[1,J]; Write(A1[K,J]:3); End; WriteLn; End; End; Writeln; ReadLn; { 3. Удаление} WriteLn(' Столбцы, в которых первый элемент > последнего, удалены'); K:=0; 34 FOR J:=1 TO 7 DO IF A[1,J]<=A[8,J] THEN Begin Inc(K); FOR I:=1 TO 8 DO A2[I,K]:=A[I,J]; End; { Вывод измененного массива } FOR I:=1 TO 8 DO Begin FOR J:=1 TO K DO Write(A2[I,J]:3); WriteLn; End; ReadLn; { 4 . Замена } WriteLn(' Элементы первых трех столбцов заменены на их квадраты'); FOR I:=1 TO 8 DO Begin FOR J:=1 TO 7 DO Begin IF J<=3 THEN A[I,J]:=Sqr(A[I,J]); Write(A[I,J]:4); End; WriteLn; End; End. Практические задания Дан двумерный массив размером 5х6, заполненный случайным образом. • Поменять местами средние строки. • Вставить после столбцов, содержащих максимальный элемент массива, столбец из нулей. • Удалить все столбцы, в которых первый элемент больше заданного числа А. • Заменить максимальный элемент каждой строки на противоположный. 5. Обработка строк 5.1 Подсчет и вывод символов Задача 1. Подсчитать сколько букв «о» в тексте USES Crt; VAR A: STRING [255]; KB N, I: BYTE; BEGIN ClrScr; Write(' Введите тест '); ReadLn(A); N:=Length(A); KB:=0; FOR I:=1 TO N DO IF (A[I]=’o’) OR (A[I]=’O’) THEN KB:=KB+1; WritLn (‘ Количество букв «о» =’,KB); END. Задача 2. Определить среднюю длину слова в тексте. USES Crt; VAR A: STRING [240]; KS, KB, N, I: INTEGER; BEGIN ClrScr; Write(' Введите тест '); ReadLn(A); N:=Length(A); 35 KS:=0; KB:=0; FOR I:=1 TO N DO IF (A[I]=' ') OR (A[I]=',') OR (A[I]='.') THEN KS:=KS+1 ELSE KB:=KB+1; IF (A[N]<>' ') AND (A[N]<>'.') AND (A[N]<>',') THEN KS:=KS+1; WriteLn( 'Средняя длина слова = ',KB/KS:3:0); END. Задача 3. Подсчитать, сколько слов в тексте начинается на букву «а» (слова разделены пробелом). USES Crt; VAR A: STRING [240]; KS, N, I: INTEGER; BEGIN ClrScr; Write(' Введите тест '); ReadLn(A); N:=Length(A); IF A[1]=’А’ THEN KS:=1 ELSE KS:=0; FOR I:=2 THEN N IF (COPY(A,I,2) =’ а’) OR (COPY(A,I,2)=’ А’ THEN KS:=KS+1; WriteLn (‘Количество слов, начинающихся на букву «а» =’,KS); END. Практические задания 1. Подсчитать, сколько слов в тексте оканчивается на букву “а”. 2. Подсчитать, сколько букв “т” в последнем предложении. 3. Подсчитать, сколько раз встречается в тексте слово “кот”. 5.2 Удаление символов Задача 1. Удалить лишние пробелы между словами, оставив по одному. USES Crt; VAR S:STRING[255]; I,K: INTEGER; BEGIN ClrScr; Write(' Введите текст '); ReadLn(S); I:=1; While(I<=Length(s)) DO Begin IF Copy(S,I,2)=' ' THEN Begin Delete (S,I,1); I:=I-1; End; I:=I+1; End; Write(S); END. Задача 2. В тексте удалить все слова, заканчивающиеся на букву "e". USES Crt; VAR S: STRING [250]; PS,N,I: INTEGER; BEGIN ClrScr; Write(' Введите текст '); ReadLn(S); S:= ' '+S+' '; FOR I:=1 TO Length(S) DO Begin 36 IF S[I]=' ' THEN Begin PS:=I-1; IF S[PS]='E' THEN WHILE(S[PS]<>' ') DO Begin Delete(S,PS,1); PS:=PS-1; End; End; End; WriteLn (‘ Измененный текст:’); Write(S); END. Задача 3. Из текста удалить каждое второе слово. Слова разделены пробелом. USES Crt; Type MAS= STRING [20]; VAR A : MAS; I,K: INTEGER; BEGIN ClrScr; Write(' Введите текст '); ReadLn(A); i:=1; While (I<=Length(A)) DO Begin IF A[I]=' ' THEN Begin K:=I+1; While (A[K]<>' ') DO Delete(A,K,1); I:=I+1; End; I:=I+1; End; WriteLn(‘Измененный текст:’); Write(A); END. Практические задания 1. В третьем предложении текста удалить все слова «мир» 2. Из строки символов удалить все гласные буквы 3. Из строки символов удалить заданное слово 4. Удалить все символы «!», следующие за вторым предложением 5.3 Вставка символов Задача 1. В текст вставить символ пробел после каждого имеющегося символа пробел. USES Crt; VAR A : STRING [255]; I: INTEGER; BEGIN ClrScr; WriteLn(' Введите текст'); ReadLn(A); I:=1; While (I<=Length(A)) DO Begin IF A[I]=' ' THEN Begin Insert (' ',A,I); I:=I+1; End; I:=I+1; End; WriteL n(‘Измененный текст:’); WriteLn(A); END. Задача 2. Третье предложение в тексте заключить в скобки. USES Crt; 37 VAR A: STRING [200]; I,K,F: INTEGER; BEGIN ClrScr; Write(' Введите текст '); ReadLn(A); I:=1; K:=0; F:=0; While (I<=Length(A)) DO Begin IF A[I]='.' THEN K:=K+1; IF (K=2) AND (F=0) THEN Begin Insert('(',A,I+1); F:=1; End; IF (K=3) AND (F=1) THEN Begin Insert(')',A,I+1); F:=0; End; I:=I+1; End; WriteLn (‘Измененный текст:’); WriteLn(A); END. Задача 3. Исправить ошибки в тексте. Во все слова "длиный" вставить букву "н". USES Crt; VAR S : STRING [50]; PZ, I: INTEGER; BEGIN ClrScr; WriteLn(‘ Введите текст’); ReadLn(S); FOR I:=1 TO Length(S) DO IF Copy(S,I,6)=' длиный' THEN Insert('н',S,I+3); WriteLn (‘Измененный текст:’); WriteLn(S); END. Практические задания 1. Исправить ошибки в тексте: в словах “рож”, “мыш”, “доч” в конце поставить “ь”. 2. В тексте в последнем предложении после слова «мама» вставить «и папа». 3. В тексте после слов «например» поставить «,». 4. В тексте во втором предложении после слов «Ура» поставить «!!!». 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); 38 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 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. Из текста удалить все слова, начинающиеся и оканчивающиеся на одну и ту же букву. 39 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; SetLineS tyle(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; 40 {Пользовательский шаблон заполнения} 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); 41 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; {процедура - лунная ночь со звездами} 42 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); { Построение стрелок } 43 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 44 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; 45 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. Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран круг, квадрат или треугольник. uses crt; var i:byte; CH:CHAR; begin clrscr; for i:=0 to 255 do write (chr(i):2); REPEAT CH:=READKEY; WRITE(ORD(CH):4); UNTIL CH='D'; end. |