if length(s)>79 then begin writeln('ERROR: stroka doljna biti <=79 simvolov'); goto 1; end;
write('Vvedite ZADANII SIMVOL:'); readln(c);
i:=0;
repeat p:=pos(' ',s);
if pos(c,copy(s,1,p-1))<>0 then begin inc(i); m[i]:=copy(s,1,p-1); end; delete(s,1,p); until p=0; n:=i; f pos(c,copy(s,1,length(s)-1))<>0 then begin n:=i+1; m[n]:=copy(s,1,length(s)-1); end;
max:=m[1]; min:=m[1];
for i:=2 to n do begin if length(m[i])>length(max) then max:=m[i];
if length(m[i])<length(min) then min:=m[i]; end;writeln;
writeln('MakS: ',max);
writeln('MIN: ',min);
readln; readln;
end.
12.Описание: Счет количества вхождений каждого символа в строку.
program one;
Var I : Word; M : Array [0..255] Of Byte; S : String;
Begin For I := 0 To 255 Do M[I] := 0;
writeln('input string');
Readln(S);
For I := 1 To Length(S) Do Begin Inc(M[ORD(S[I])]); End;
For I := 0 To 255 Do Begin If M[I] > 0 Then WriteLn(CHR(I):3, M[I]:3); End; readln;
End.
13.Описание: Удаление пробелов из заданной строки и вывод результата.
program one;
Var S,T : String; I : Integer;
Begin writeln('input string');
readln(s);
T := '';
For I := 1 To Length(S) Do Begin If (S[I] <> ' ') Then T := T + S[I];
End;
WriteLn(T);
ReadLn;
End.
14.Описание: Вывести заданный символ заданное количество раз
program one;
uses crt;
var n:byte; l:string;n function zvezda(n:byte;l:string):real; var i:integer; s:string;
begin i:=1;
s:='';
while i<=n do begin s:=s+l;
inc(i); end;
writeln(s); end;
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.