begin clrscr;

writeln('Vvedite chislo'); readln(n);

writeln('Vvedite simvol'); readln(l);

zvezda(n,l);

readkey;

end.

15.Описание: Заменить строку звездочками, если строка содержит кавычки

Program one;

var S : string; i : integer;

found : boolean;

begin Write('vvedite stroku simvolov : ');

Readln(S); Found := FALSE;

for i := 1 to Length(S) do {Length(s) = длинна строки, стандартная функция}

if s[i] = '''' then found := TRUE; if Found then {если найден символ "",заменяем}

for i := 1 to Length(S) do s[i] := '*'; Writeln('Rezultiruyuschaya stroka: ', S);

readln;

end

Раздел: Графика

1.Описание: Зеленый перевернутый лист папоротника, заполняющийся точками.

program Fract;

uses Graph,Crt;

var Dt,M : integer; R,A,B,C,D,E,F, NewY,NewX,X,Y : real;

begin Dt := Detect;

InitGraph(Dt, M,'');

Randomize;

X := 0; Y := 0;

repeat R := Random;

if R>0.93 then begin A := -0.15; B := 0.28; C := 0.26; D := 0.24; E := 0; F := 0.44;

end else if R>0.86 then begin A := 0.2; B := -0.26; C := 0.23; D := 0.23; E := 0; F := 1.6;

end else if R>0.01 then begin A := 0.85; B := 0.02; C := -0.02; D := 0.85; E := 0; F := 1.6;

end else begin A := 0; B := 0; C := 0; D := 0.16; E := 0; F := 0; end;

NewX := A*X + B*Y + E; NewY := C*X + D*Y + F; X := NewX; Y := NewY;

PutPixel(Round(X*50)+100,Round(Y*50)+50, Green);

until(Keypressed);

CloseGraph;

end.

2.Описание: Стрелочные часы с быстроидущей секундной стрелкой и показом реального времени.

Program 4as;

uses graph, crt, dos;

type TPoint = record

x, y: Real; end;

var H, M, S, Hund : Word; Xc, Yc, i : Integer; P, P2, P3, P4, P5, P6 : TPoint;

procedure Dec2Polar(Ang, Len: Real; var P: TPoint);

begin Ang := Ang - 90; { Correlation for our coord system }

P.x := Xc + Len * cos(Ang * Pi / 180);

P.y := Yc + Len * sin(Ang * Pi / 180);end;

begin i := 0;

InitGraph(i, i, '');

Xc := GetMaxX div 2; Yc := GetMaxY div 2; SetColor(10);

Circle(Xc, Yc, Yc - 30); SetColor(2); Circle(Xc, Yc, 3); SetColor(14);

for i := 0 to 23 do begin Dec2Polar(i * 15, Yc - 40, P);

Circle(Round(P.x), Round(P.y), 2 + 3*Byte(i mod 2 = 0)); end;{ SetLineStyle(0, 0, 3);}

while not keypressed do begin { Erase } SetColor(0); Line(Round(P2.x), Round(P2.y), Round(P.x), Round(P.y));

Line(Round(P4.x), Round(P4.y), Round(P3.x), Round(P3.y));

Line(Round(P6.x), Round(P6.y), Round(P5.x), Round(P5.y));

GetTime(H, M, S, Hund); { Second arrow }

Dec2Polar((S + Hund/100) * 6, Yc - 50, P);

Dec2Polar((S + Hund/100) * 6, 5, P2); { Minute arrow }

Dec2Polar((M + S/60) * 6, Yc - 100, P3);

Dec2Polar((M + S/60) * 6, 5, P4); Dec2Polar((H + M/60) * 30, Yc - 150, P5);

Dec2Polar((H + M/60) * 30, 5, P6); { Redraw } SetColor(15);

Line(Round(P2.x), Round(P2.y), Round(P.x), Round(P.y)); SetColor(9);

Line(Round(P4.x), Round(P4.y), Round(P3.x), Round(P3.y)); SetColor(7);

Line(Round(P6.x), Round(P6.y), Round(P5.x), Round(P5.y)); delay(1000); end; CloseGraph;

end.

3.Описание: Скачущий мяч с постепенным снижением амплитуды.

program ufo;

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);

floodfill(x,y,12);

repeat until keypressed;closegraph

end.

4.Описание: Нло в замкнутом пространстве на фоне звездного неба.

program ufo;

uses graph,crt;

const r=20; pause=50; var d,m,e,xm,ym,x,y,lx,ly,rx,ry, size,i,dx,dy,width,height:integer; saucer:pointer;

label loop;

begin d:=detect;

initgraph(d,m,'');

e:=graphresult;

if e<> grok then writeln(grapherrormsg(e)) else begin x:=r*5; y:=r*2;

xm:=getmaxx div 4; ym:=getmaxy div 4;

ellipse(x,y,0,360,r,r div 3+2); ellipse(x,y-4,190,357,r,r div 3);

line(x+7,y-6,x+10,y-12); line(x-7,y-6,x-10,y-12);

circle(x+10,y-12,2); circle(x-10,y-12,2);

floodfill(x+1,y+4,white);

lx:=x-r-1; ly:=y-14;

rx:=x+r+1; ry:=y+r div 3+3;

width:=rx-lx+1; height:=ry-ly+1;

size:=imagesize(lx,ly,rx,ry);

getmem(saucer,size); getimage(lx,ly,rx,ry,saucer^);

putimage(lx,ly,saucer^,xorput);

rectangle(xm,ym,3*xm,3*ym);

setviewport(xm+1,ym+1,3*xm-1,3*ym-1,clipon); xm:=2*xm; ym:=2*ym;

for i:=1 to 200 do

putpixel(random(xm),random(ym),white);

x:=xm div 2;

y:=ym div 2;

dx:=10; dy:=10; repeat putimage(x,y,saucer^,xorput); delay(999);

putimage(x,y,saucer^,xorput);

loop: x:=x+dx; y:=y+dy;

if (x<0) or (x+width+1>xm) or (y<0) or (y+height+1>ym) then begin x:=x-dx; y:=y-dy;

dx:=getmaxx div 10-random(getmaxx div 5); dy:=getmaxy div 30-random(getmaxy div 15); goto loop end until keypressed;

if readkey=#0 then x:=ord(readkey);

closegraph end

end.

5.Описание: Заполнение квадрата случайными линиями разных цветов.

program graphik;

uses graph,crt;

var d,r,e:integer; x1,y1,x2,y2:integer;

begin clrscr;

d:=detect;

initgraph(d,r,'');

e:=graphresult;

if e <> grok then writeln(grapherrormsg(e)) else begin x1:=getmaxx div 3;

y1:=getmaxy div 3;

x2:=4*x1;y2:=4*y1;

rectangle(x1,y1,x2,y2);

setviewport(x1+1,y1+1,x2-1,y2-1,clipon);

repeat setcolor(succ(random(16)));

line(random(x2-x1),random(y2-y1),random(x2-x1),random(y2-y1))

until keypressed;

if readkey=#0 then d:=ord(readkey);

closegraph

end end.

6.Описание: Медленно выезжающий кусок пирога или пиццы.

program pie;

uses crt,graph;

var graphdriver,graphmode,errorcode:integer; j,v,l,m,k,i:integer;

begin graphdriver:=detect;

initgraph(graphdriver,graphmode,'');

errorcode:=graphresult;

if errorcode<>grOk then begin writeln('ЋиЁЎЄ Ја дЁЄЁ: ',graphErrorMsg(errorcode));

writeln('Џа®Ја ¬¬ ў аЁ©-® § ўҐаиЁ« а Ў®вг...');

halt(1); end;

setcolor(yellow);

circle(200,200,50);

floodfill(199,199,yellow);

delay(30000);

setcolor(black);

pieslice(200,200,30,60,50);

for i:=1 to 20 do begin setcolor(yellow);

pieslice(200+i,200-i,30,60,50);

setcolor(black);

pieslice(200+i,200-i,30,60,50);

delay(30000);

i:=i+1; end;

readkey;

closegraph;

end.

7.Описание: Статичное изображение двухколесного велосипеда.

program gr;

uses graph;

var grDriver:integer;

grMobe:integer;

Begin grDriver:=Detect;

InitGraph(grDriver,grMobe,'');

SetColor(12);

circle(200,150,30);circle(200,150,23);circle(330,150,30);circle(330,150,23);line(200,150,280,150);line(280,150,320,110);line(320,110,210,110);line(210,110,250,150);line(200,150,210,110);circle(200,150,5);circle(270,150,10);line(270,150,270,170);line(265,170,275,170);line(200,145,270,140);line(200,155,270,160);line(330,150,320,110);line(320,110,320,98);line(320,98,310,98);line(210,110,210,100);circle(210,100,5);line(210,100,220,100);line(270,150,270,130);line(265,130,275,130);readln;

End.

8.Описание: Приближающийся на смотрящего квадрат. Увеличение размеров по времени.

program gr;

uses graph,crt;

VAR x,y,i:integer;

PROCEDURE grafika_on;

Var drv,mode:integer;

BEGIN drv:=9; {VGA }mode:=2; {VGAHi}

initgraph(drv,mode,'');END;

BEGIN grafika_on;

x:=300; y:=200;

for i:=1 to 100 do begin setcolor(9);

rectangle(x-i,y-i,x+i,y+i);

delay(100); setcolor(0); rectangle(x-i,y-i,x+i,y+i);

end; readkey; closegraph;

END.

9. Описание:Строительство башни по блокам.

program gr;

Uses crt, Graph;Var P:pointer;Size:Word; X1,Y1:Word; gd,gm: integer;

Begin gd:=detect;

InitGraph(gd,gm,'');

IF GraphResult<>0 THEN Halt(1);

SetViewPort(0,0,640,80,TRUE);

ClearViewPort;

SetBkColor(black);SetColor(yellow);

SetLineStyle(0,1,Thickwidth);Rectangle(120,400,200,440);

Size:=ImageSize(120,400,200,440);

GetMem(p,Size);

GetImage(120,400,200,440,P^);

Y1:=440;

WHILE Y1>=40 DO begin X1:= 120;

begin PutImage(X1,Y1,p^,CopyPut); Delay(59000);

X1:=X1+80 end;

Y1:=Y1-40 end; x1:=x1-160;WHILE X1<=280 DO Begin PutImage(X1,Y1,p^,CopyPut);

X1:=X1 +160 end;

setfillstyle(8,red);

Bar(200,40,280,500); Bar(40,40,120,500);

SetColor(11);SETTEXTSTYLE(6,7,6);

outtextxy(350,100,'BASHNYA!');Readln;

CloseGraph End.

10. Описание:Пульсирующее сердце (анимация).

program gr;

uses crt,graph;var driver,mode,error:integer; l,n,m,x,y,r:integer;

begin driver:=detect;

initgraph(driver,mode,'');

error:=graphresult;

if error<>grOk then begin writeln('ЋиЁЎЄ Ја дЁЄЁ: ',graphErrorMsg(error));

writeln('Џа®Ја ¬¬ ў аЁ©-® § ўҐаиЁ« а Ў®вг...'); halt(1); end;

m:=1;l:=1;x:=1;y:=1;r:=1;n:=1;

repeat x:=1;y:=1;r:=1;l:=1;

repeat begin setcolor(cyan);

arc(170-x,150,0,180,20+r); arc(210+x,150,0,180,20+r);

line(150-2*x,150,190,200+y); line(230+2*x,150,190,200+y);

floodfill(149,150,cyan);

x:=x+1;y:=y+1;r:=r+1;

delay(20); clearviewport;

l:=l+1; end; until l=20;

x:=1;y:=1;r:=1;m:=1;

repeat setcolor(cyan);

arc(150+x,150,0,180,40-r); arc(230-x,150,0,180,40-r);

line(110+2*x,150,190,220-y); line(270-2*x,150,190,220-y);

floodfill(149,150,cyan);

x:=x+1;y:=y+1;r:=r+1;m:=m+1; delay(20);

clearviewport; until m=20; n:=n+1; until n=20; closegraph;

end.

11. Описание: Динамическое изображение планеты сатурн с помощью эллипсов.

program graphik;

uses graph,crt;

var a,b,e:integer;

begin a:=detect;

initgraph(a,b,'');

e:=graphresult;

if e<>grok then writeln(grapherrormsg(e))

else begin repeat setlinestyle(2,5,2*2+5);

setcolor(random(3));

ellipse(300,250,128,52,random(300),random(100));

setcolor(random(8));

ellipse(300,250,0,360,random(200),200);

until keypressed;

closegraph;end

end.

12.Описание: Медленно поднимающийся вверх воздушный шар.

Program one;

uses crt,graph;

var gd,gm,y,size:integer; p:pointer;

begin initgraph(gd,gm,'');size:=imagesize(50,200,150,400);getmem(p,size);setcolor(14);

setfillstyle(1,14);arc(100,250,0,180,50);line(50,250,150,250);

floodfill(120,240,14);setcolor(1);line(50,250,75,350);

line(150,250,125,350);setcolor(4);setfillstyle(1,4);

bar(75,350,125,400);

getimage(50,200,150,400,p^);setfillstyle(1,0);

for y:=480 downto 0 do begin putimage(50,y,p^,1);delay(1000);cleardevice;

bar(50,y,150,y+100);

end; readln; closegraph;

end.

13.Описание: Снеговики стоят в несколько рядов один за другим.

program snegovik;

uses graph;

var i,j,x,y:integer;grdriver:integer;grmode:integer;begin grdriver:=detect;initgraph(grdriver,grmode,'c');

x:=50;y:=30;

for i:=1 to 10 do begin for j:=1 to 10 do begin setcolor(blue);

circle(x,y,10);circle(x,y+30,20);

circle(x,y+80,30);circle(x-30,y+30,10);

circle(x+30,y+30,10);setcolor(5);

line(x,y-5,x+15,y);line(x,y+5,x+15,y);setcolor(white);

line(x-5,y+5,x+5,y+5);

putpixel(x-5,y-5,white);putpixel(x+5,y-5,white);

putpixel(x,y+20,white);putpixel(x,y+30,white);

putpixel(x,y+40,white);putpixel(x,y+60,white);

putpixel(x,y+70,white);putpixel(x,y+80,white);

putpixel(x,y+90,white);putpixel(x,y+100,white);setcolor(3);

line(x-5,y-10,x+5,y-10);line(x+5,y-10,x,y-20);line(x,y-20,x-5,y-10);

x:=x+90;end;

y:=y+160;x:=50;

end;readln

end.

14.Описание: Снежика, рисуемая в зависимости от длины и количества лучей и глубины рекурсии.

Program Snezhinka;

Uses crt, graph;

const k = 150; n = 8; g = 4;

var gd, gm: integer; procedure Snezhinka_v_zh (x, y: word; r, c: byte); var alpha: real; i: byte; xd, yd: integer;

begin if c < 1 then exit;

for i := 1 to n do

begin alpha := 2 * Pi * i / n;

xd := round(x + r * cos(alpha));

yd := round(y + r * sin(alpha));

moveto(x, y); lineto(xd, yd);

Snezhinka_v_zh(xd, yd, r div 3, c - 1); end; end;

BEGIN initgraph(gd, gm, 'h:\tp\bgi'); setcolor(11);

snezhinka_v_zh(320, 240, k, g); readkey;

closegraph;

END.

15.Описание: Нарисовать радугу, используя элипсные дуги разных цветов.

Program Raduga;

Uses Graph;

var D,M,y,i : Integer;

begin D := Detect;

InitGraph(D,M,'');

if GraphResult <> grOk then WriteLn(GraphErrorMsg(GraphResult)) else begin y:=200;

for i:=1 to 30 do begin if i<5 then SetColor(4); if (i>5)and(i<10) then SetColor(14); if (i>10)and(i<15) then SetColor(2); if (i>20)and(i<25) then SetColor(1); if i>25 then SetColor(13);

Ellipse(325,y,10,170,240,150); inc(y); end;

Readln; CloseGraph; end;

end.

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10