insert('<<',s,i-1);
i:=i+2;
end;
end;
Writeln('Преобразованная строка: ',s);
Write('Нажмите Enter');
Readln;
end.
Задание 3. Составить программу, которая запрашивает имя человека и повторяет его на экране с Приветствием
Program as;
Uses crt;
Var K:string;
Begin clrscr;
Writeln(‘Как вас зовут’);
Readln(k);
Writeln(‘Привет,’ ‘,k’!’);
End.
Задание 4. Составить программу, которая запрашивает название футбольной команды и повторить его на экране со словом «Это чемпион!»
Program as;
Uses crt;
Var k:string;
Begin clrscr;
Writeln(‘Введите название футб. команды’);
Readln(k);
Writeln(k,’ ’,’Чемпион!’);
End.
Задание 5. Дана строка символов s1,s2,...sn, в которой встречаются цифры, пробелы, буква Е и знаки + и -. Известно, что первый символ строки является цифрой. Из данной строки выделить подстроку предшествующую первому пробелу. Требуется: определить является ли это подстрока числом, если да, то выяснить целым или вещественным, положительным или отрецательным
Program Stroki;
Uses Crt;
Var s1,s2:string;
i:Integer;
k:Real;
f:boolean;
begin
ClrScr;
Writeln('Введите строку символов:');
Readln(s1);
s2:='';
f:=true;
for i:=1 to length(s1) do begin
if s1[i]=' ' then f:=false;
if (s1[i]<>' ') and (f=true) then s2:=s2+s1[i];
end;
Writeln('Выделенная подстрока: ',s2);
Val(s2,k,i);
if i<>0 then Writeln('Выделенная подстрока не содержит числовое значение')
else begin
f:=false;
for i:=1 to length(s2) do
if s2[i]='E' then begin
Write('Число в подстроке вещественного типа, ');
f:=true;
end;
if f=false then Write('Число в подстроке целочисленного типа, ');
if k<0 then Writeln('отрицательное')
else Writeln('положительное')
end;
Write('Для выхода нажмите Enter');
Readln;
end.
Задание 6. Дано название футбольного клуба, определить кол-во символов в нем
Program as;
Uses crt;
Var k:string; M:integer;
Begin clrscr;
Writeln(‘Введите название Ф.К’);
Readln(k);
M:=length(k);
Writeln(M);
End.
Задание 7. Дано название города, определить четно или нет, кол-во символов в нем
Program as;
Uses crt;
Var k:string;b:integer;
Begin clrscr;
A:=’Aktobe’;
B:=length(a);
If b mod 2=0 then write(‘четно ‘) else write(‘нечетно ‘);
Readln;
End.
Задание 8. Дана строка, содержащая текст. Записать её в обратном порядке
program з8;
var s1,s2: String;
i: Integer;
begin
Write('Введите строку=');
ReadLn(s1); s2:='';
for i:=Length(s1) downto 1 do s2:=s2+s1[i]; WriteLn('Обратная строка=',s2);
ReadLn; end.
Задание 9. Дано слово. Заменить «о» на «е»
Program as;
Uses crt;
Var a:string; e,I,b:integer;
Begin clrscr;
Writeln(‘Dano clovo’);
Readln(a);
B:=length(a);
For i:=1 to b do if copy(a,I,1)=’o’ then begin
Delete(a,I,1);
Insert(‘e’,a,i);
End;
Writeln(a);
End.
Задание10. Даны 2 фамилии опред какая из них длиннее
Program as;
Uses crt;
Var a,b:string; c,d:integer;
Begin clrscr;
A:=’kolin’;
B:=’imanalin’;
C:=length(a);
D:=:=length(b);
If c>d then write(a) else write(b);
End.
Графика в Турбо-Паскале
Задание 1. При нажатии на Enter плавно перемещает треугольник c вершинами (10,10);(10,100);(100,100) на 10 пунктов по X, и по Y
uses crt,graph;
const n=4;
type
Point=record
x,y:integer;
end;
mas=array[1..n] of Point;
procedure Z(x,y:integer;var m:mas;c:byte);
var i:byte;
begin
Setcolor(c);
m[1].x:=x;m[1].y:=y;
m[2].x:=x;m[2].y:=y+90;
m[3].x:=x+90;m[3].y:=y+90;
m[4].x:=x;m[4].y:=y;
moveto(m[1].x,m[1].y);
for i:=1 to n do
lineto(m[i].x,m[i].y);
Setfillstyle(1,c);
end;
var gd,gm:integer;
x,y,x1,y1,i:integer;
p:mas;
c1,c2:byte;
k:char;
move:boolean;
begin
gd:=VGA;
gm:=VGAHi;
Initgraph(gd,gm,'..\bgi');
Setbkcolor(8);
x:=10;y:=10;
c1:=7;c2:=8;
move:=true;
repeat
if keypressed then
begin
k:=readkey;
if k=#13 then {if enter}
for i:=1 to 10 do
begin
y1:=y;
x1:=x;
y:=y+1;
x:=x+1;
delay(6000);
Z(x1,y1,p,c2);
Z(x,y,p,c1);
move:=true;
end;
end;
if move then
begin
Z(x1,y1,p,c2);
Z(x,y,p,c1);
move:=false;
end;
OutTextXY(320,240,'Press Enter to continue');
until k=#27; {until escape}
closegraph;
end.
Задание 2. Изобразить на экране скачущий мяч. Использовать графический режим
uses crt,graph;
const r=20;h=5;
var gd,gm,i,n,t,x,y,p:integer;
begin
clrscr;
gd:=Detect;
initgraph(gd,gm,'c:\bp\bgi ');
setcolor(4);
setlinestyle(0,1,1);
line(0,479,639,479);
x:=r;y:=r;
t:=479-2*r;
n:=t div h;
p:=h;
while n<>0 do begin
for i:=1 to n do begin
setcolor(2);
circle(x,y,r);
setfillstyle(1,2);
floodfill(x,y,2);
delay(10);
setcolor(0);
circle(x,y,r);
setfillstyle(1,0);
floodfill(x,y,0);
y:=y+p;
x:=x+1;
end;
if p>0 then begin t:=round(3*t/4);n:=t div h end;
p:=-p end;
setcolor(12);
circle(x,y,r);
setfillstyle(1,2); repeat until keypressed;closegraph
floodfill(x,y,12); end.
Задание 3. Анимационная картинка - кораблик совершает путь по заданной траектории...все происходит довольно быстро
program corablik;
uses Graph, Crt;
var
grDriver: integer;
grMode: integer;
ErrCode: integer;
x,y,y0,a,b: integer;{a,b-переменные для линии моря, чтоб они не зависели от х,у}
procedure more(a,b:integer);
begin
moveto(0,y0);
setcolor(blue);
for a:=0 to 680 do{слева направо рисуем синусоиду синего чвета}
begin
b:=y0-round(sin(a*pi/180)*30);{30-коэффициент масштабирования по оси Х,
чем больше, тем волна круче}
lineto(a,b);
end;
end;
begin
grDriver:= Detect;
InitGraph(grDriver, grMode, '..\BGI');
ErrCode:= GraphResult;
y0:= 250;
if ErrCode = grOk then
begin
x:=600;
while x>=0 do{лучше использовать цикл while, можно менять величину шага,
что тоже влияет на скорость и частоту смены картинки}
begin
cleardevice;
more(a,b);{рисуем волну}
setcolor(white);{устанавливаем цвет кораблика}
y:=y0-40-round(sin(x*pi/180)*30);{движемся по волне}
MoveTo(x - 40, y + 20);
LineTo(x - 20, y + 40);
LineTo(x + 20, y + 40);
LineTo(x + 40, y + 20);
LineTo(x - 40, y + 20);
MoveTo(x + 15, y + 20);
LineTo(x + 15, y - 40);
LineTo(x - 20, y + 20);
LineTo(x + 15, y + 20);
delay(100); {нормальная скорость, если модули *.TPL не глючные как у Вас,
время должно быть в миллисекундах, а не в каких-нибудь наносекундах}
x:=x-2;{шаг движения}
end;
end
else Writeln('Graphics error: ', GraphErrorMsg(ErrCode));
Settextstyle(0,0,3);{устанавливаем стиль шрифта}
cleardevice;
setcolor(red);
OuttextXY(200,240,'Rejs zavershen!');{выводим надпись}
readln;
CloseGraph;
end.
Задание 4. Анимация - прямоугольничек красного цвета совершает полный путь по экрану монитора!
program kv;
uses
crt, graph;
var
x, y, dx, dy, w, h, driver, mode: integer;
begin
initgraph(driver, mode, 'G:/BP/BGI');
if graphresult<>0 then begin
writeln('none');
halt
end;
dx:=1;
dy:=0;
w:=100;
h:=10;
repeat
setfillstyle(1, black);
bar(x, y, x+w, y+h);
x:=x+dx;
y:=y+dy;
setfillstyle(1, red);
bar(x, y, x+w, y+h);
delay(100);
if (x+w>=getmaxx)and(y<=0) then
begin
dx:=0;
dy:=1;
end
else
if (y+h>=getmaxy)and(x+w>=getmaxx) then
begin
dx:=-1;
dy:=0;
end
else
if (x<=0)and(y+h>=getmaxy) then
begin
dx:=0;
dy:=-1;
end
else
if (y<=0)and(x<=0) then
begin
dx:=1;
dy:=0;
end;
until keypressed;
closegraph;
end.
Задание 5. Люди часто просят нарисовать самый обычный рисунок из разных тем...например нарисую"программиста"
Program bugalteria;
Uses crt,graph;
Var gd,gm:integer;
begin
clrscr;
Detectgraph (gd,gm);
Initgraph (gd,gm,'C:\tp7');
{Зарисовка стола}
Bar (120,330,360,360);
Bar (180,360,330,480);
{Зарисовка компьютера}
Line (180,240,180,330);
Line (180,270,210,330);
Line (172,210,202,300);
Line (180,210,210,300);
Line (210,300,202,300);
Line (180,210,172,210);
Line (270,322,270,330);
Line (270,322,330,330);
{Зарисовка стула}
Bar (420,405,510,420);
Bar (456,420,480,480);
{Зарисовка бухгалтера работающего за компьютером}
Line (510,405,540,300);
Line (334,480,390,390);
Line (390,390,510,390);
Line (360,480,420,405);
Line (510,390,450,240);
Line (480,390,420,300);
Line (420,300,430,240);
Line (450,270,330,300);
Line (330,300,310,310);
Circle (435,195,40);
Readln
end.
Задание 6. Построить один прямоугольник и заполнить его случайно расположенными точками (в пределах 100 штук) и второй прямоугольник в котором проведены случайные линии (различными цветами)
program пример;
uses graph, crt;
var gd,gm,xl,yl,x2,y2,x,y,x3,y3,i,errcode: integer;
begin
gd:=0; gm:=0;
InitGraph (gd,gm,’ ‘);
[построение первого прямоугольника]
x1:=10; y1:=10; x2:=200; y2:=200;
rectangle(x1,y1,x2,y2);
[вывод случайных точек]
for i:=1 to 100 do
begin
x:=random(x2-xl)+x1;
у:=random(y2-yl)+y1;
putpixel(x,y,2)
end;
[построение второго прямоугольника]
xl:=210; yl:=210; x2:=400; y2:=400;
rectangle(xl,yl, x2,y2);
[вывод случайных линий]
for i:=l to 100 do
begin
setcolor(random(15));
x:=random(x2-xl)+xl;
y:=random(y2-yl)+yl;
x3:=random(x2-xl)+xl;
y3:=random(y2-yl)+yl;
Iine(x,y,x3,y3);
end;
while not keypressed do;
closegraph
end.
Задание 7. Изобразить линии разного стиля и толщины
program пример;
[ вывод линий разного вида]
uses graph,crt;
var gd,gm: integer;
begin
gd:=0; gm:=0; initgraph (gd, gm, ' ');
line (0, 0, 300, 0); [линия обычного образца]
setlinestyle(l,0,l);line(0,20,300,20);[линия из точек]
setlinestyle(2,0,l);line(0,40,300,40);[пунктирная линия]
setlinestyle (3,0,1);line(0,60,300,60);[штриховая линия]
setlinestyle(0,0,3);line(0,80,300,80);[сплошная толстая линия]
while not keypressed do;
closegraph end.
Задание 8. Построить окружность и описать вокруг нее квадрат
program пример;
[квадрат и вписанная окружность]
uses graph, crt;
var gd,gm,x,y,r,x1,y1,x2,y2: integer; xa,ya:word;
begin
writeIn (‘введи координаты центра окружности и радиус’);
readln(x,y,r);
gd:=0; gm:=0; initgraph(gd,gm, ‘ ‘);
circle(x, у, г);
getaspectratio(xa,ya);
x1:= x-r; у1:= round (y -r*(xa/ya));
x2:=x+r; y2:= round (y+r*(xa/ya));
rectangle(xl,yl,x2,y2);
while not keypressed do;
closegraph end.
Задание 9. Построить дугу от 0 до 90 градусов и от 270 до 450 градусов
program пример;
[дуги окружности от 0 до 90 и от 270 до 450]
uses graph,crt;
var gd,gm,x,y,r,xl,yl: integer; xа,уа:word;
begin
gd:=0; gm:=0; initgraph(gd,gm,’ ‘);
getaspectratio(xa,ya);
{строим оси координат}
line(0,100,300,100); line(150,0,150,200);
{ строим дугу от 0 до 90 }
агс(150,100,0,90,40);,
line (310, 100,610,100); line(460,0,460,200);
{ строим дугу от 270 до 450 }
arc(460,100,270,540,40);
while not keypressed do; end.
Задание10. Построить дуги элипсов
program пример;
[дуги эллипсов при разном соотношении Rx и Ry]
uses graph,crt;
var gd,gm:integer; xa,ya:word;
begin
gd:=0; gm:=4; initgraph (gd, gm, ‘ ‘);
getaspectratio(xa, ya);
{ первая дуга}
line(0,100,l60,100);
line(80, 55, 80,145);
ellipse(80,100,180, 90,40,40);
{ вторая дуга}
line(190,100,410,100);
line(300,55,300, 145);
ellipse(300, 100, 0, 359,100,20);
{ третья дуга}
line(440,100,600,100);
line(520,55,520,145);
ellipse (520, 100, 0,270,40, round (40* (xa/ya)));
while not keypressed do; end.
Задание11. Построить прямоугольники в два ряда по четыре прямоугольника в ряд и заполнить их соответственно 12-ю различными типами штриховки
program пример;
{демонстрация цветов заполнения}
uses graph,crt;
var gd,gm,x,y,k, j:integer;
begin
gd:=0; gm:=0; initgraph (gd, gm, ' ');
x:=60; y:=40;
for j:=0 to 2 do
for k:=0 to 3 do
begin
rectangle ((k + 1) *x,(j+1)*y, (k+2)*x, (j+2)*y);
setfillstyle{k+j*4, j+1);
bar((k+1)*x+1, (j+1)*y+1, (k+2)*x-1, (j+2)*y-1)
end;
while not keypressed do;
end.
Задание12. Построить окружность и описать вокруг нее квадрат,а затем область внутри квадрата, но вне окружности закрасить цветом фона
program пример;
{ квадрат и вписанная окружность}