Графика в Турбо Паскаль - Turbo Pascal - Страница 4

@Puporev · 26.04.2010, 06:16

Студворк — интернет-сервис помощи студентам

Не по теме:

Wolf, Ну там еще стандартную проверку на ошибку инициализации графического режима пишут, а это уже где-то 6-7 строк.

@WolfCF · 30.04.2010, 06:08

Полет космического корабля до конца экрана с использованием динамической памяти.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Uses crt,Graph;
var x1,y1,x2,y2:integer;
    xp,yp:integer;
    size:word;
    p:pointer;
Procedure GrInit;
var GraphDriver:integer;
    GraphMode:integer;
    ErrorCode:integer;
Begin
     Graphdriver:=detect;
     InitGraph(GraphDriver, GraphMode,'');
     ErrorCode:=GraphResult;
     If ErrorCode<>GrOk then
     begin
        Writeln('Oshibka grafiki',GraphErrorMsg(ErrorCode));
        Writeln('Rabota prervana');
        Halt(1);
     end;
End;
Begin
GrInit;
 SetBKColor(blue);
 SetColor(red);
 SetTextStyle(4,1,3);
 SetLinestyle(0,0,1);
 {Bar(280,220,320,240);}
 rectangle(280,220,320,240);
 line(320,220,345,230);
 line(320,240,345,230);
 rectangle(271,210,278,250);
 circle(290,230,5);
 rectangle(285,215,295,218);
 rectangle(300,215,310,218);
 rectangle(285,240,295,243);
 rectangle(300,240,310,243);
 size:=ImageSize(271,210,345,250);
 getmem(p,size);
 getImage(271,210,345,250,p^);
 cleardevice;
 y1:=5;  {точка старта по у}
      begin
            for x1:=5 to 640 do
                begin
                     putimage(x1,y1,p^,1);
                     delay(70);
                     x1:=x1+5;
                     cleardevice;
                end;
              end;
 
End.

@STGE · 02.05.2010, 01:12

Положение ударных позиций ферзи:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
Program ferzgraph;
  Uses crt,graph;
  Const a: array[1..8] of char=('a','b','c','d','e','f','g','h');
        b: array[1..8] of char=('1','2','3','4','5','6','7','8');
        d: array[1..8] of integer=(165,207,249,291,333,375,417,459);
        e: array[1..8] of integer=(78,120,162,204,246,288,330,372);
  Var gd,gm,x,y,xf,yf,zx,zy: integer; i,j: byte; c: char;
  Procedure Dsk(x1,y1,x2,y2,k,p: integer);
    Var i,j,sx,sy,xb,xc: integer;
      begin
        xb:=x1;
        xc:=x2;
        For j:=1 to k do
          begin
            For i:=1 to k do
              begin
                if (j mod 2 = 0) then
                  if (i mod 2 = 0) then
                    begin
                      Setfillstyle(1,15);
                      Bar(x1,y1,x2,y2);
                    end
                  else
                    begin
                      Setfillstyle(1,p);
                      Bar(x1,y1,x2,y2);
                    end
                else if i mod 2 = 0 then
                  begin
                    Setfillstyle(1,p);
                    Bar(x1,y1,x2,y2);
                  end
                else
                  begin
                    Setfillstyle(1,15);
                    Bar(x1,y1,x2,y2);
                  end;
                sx:=x1;
                x1:=x2+2;
                x2:=2*x2-sx+2;
              end;
            x1:=xb;
            x2:=xc;
            sy:=y1;
            y1:=y2+2;
            y2:=2*y2-sy+2;
          end;
  end;
  Procedure Linex(x1,y1,x2,y2,k,q,c: integer);
    Var i: integer;
      begin
        Setcolor(c);
        For i:=1 to k do
          begin
            Line(x1,y1,x2,y2);
            x1:=x1 + q;
            x2:=x2 + q;
          end;
      end;
  Procedure Liney(x1,y1,x2,y2,k,q,c: integer);
    Var i: integer;
      begin
        Setcolor(c);
        For i:=1 to k do
          begin
            Line(x1,y1,x2,y2);
            y1:=y1 + q;
            y2:=y2 + q;
          end;
      end;
  Begin
    randomize;
    gd:=detect;
    gm:=4;
    Initgraph(gd,gm,'');
    Repeat
      Cleardevice;
      x:=175;
      y:=380;
      Dsk(160,80,200,120,8,6);
      Linex(201,80,201,414,7,42,7);
      Liney(160,121,494,121,7,42,7);
      Setfillstyle(6,8);
      Bar(159,49,129,443);
      Bar(495,49,525,443);
      Bar(159,49,510,79);
      Bar(159,414,510,443);
      For i:=1 to 8 do
        begin
          Setcolor(15);
          Settextstyle(1,0,3);
          Outtextxy(x,413,a[i]);
          x:=x+42;
        end;
      For i:=1 to 8 do
        begin
          Setcolor(15);
          Settextstyle(1,0,3);
          Outtextxy(140,y,b[i]);
          y:=y-42;
        end;
      Settextstyle(4,0,4);
      i:=random(8)+1;
      j:=random(8)+1;
      Setcolor(cyan);
      Outtextxy(d[i],e[j],'Ф');
      Setcolor(0);
      For yf:=1 to 8 do
        For xf:=1 to 8 do
          begin
            If (xf<>i) and (yf=j) or (yf<>j) and (xf=i) then
              Circle(d[xf]+15,e[yf]+20,6);
            If (xf=i) and (yf=j) then
              begin
                zx:=xf;
                zy:=yf;
                repeat
                  zx:=zx-1;
                  zy:=zy-1;
                  Circle(d[zx]+15,e[zy]+20,6);
                Until (zx<1) or (zy<1);
                zx:=xf;
                zy:=yf;
                repeat
                  zx:=zx+1;
                  zy:=zy+1;
                  Circle(d[zx]+15,e[zy]+20,6);
                Until (zx>8) or (zy>8);
                zx:=xf;
                zy:=yf;
                repeat
                  zx:=zx-1;
                  zy:=zy+1;
                  Circle(d[zx]+15,e[zy]+20,6);
                Until (zx<1) or (zy>8);
                zx:=xf;
                zy:=yf;
                repeat
                  zx:=zx+1;
                  zy:=zy-1;
                  Circle(d[zx]+15,e[zy]+20,6);
                Until (zx>8) or (zy<1);
              end;
          end;
      c:=readkey;
    Until c=#13;
    Closegraph;
End.

@Puporev · 02.05.2010, 06:16

STGE, Нужно доделать. Юзер должен задавать поле, программа рисовать. И все таки ферзя то нужно нарисовать, а не пустое поле.

@Кетя · 16.05.2010, 17:52

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
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.

@insolent · 17.05.2010, 22:51

Мой вариант старой игры "Змейка". Условие всем известны: змея ползает по полю и кушает яблоки, при съедении яблока увеличивается.

Вложение 30283

Код немного сыроват и нуждается в дальнейшем доработке. Код разбит на модули. Также в архиве шрифт и видеодрайвер.

ЗЫЖ Небольшой нюанс: нужно выбрать оптимальное значение передаваемое Delay.

@Euronymous · 18.05.2010, 13:21

вот мой курсач на паскале. задание:
вувести НА ЭКРАН ЛИНИЮ, ЗАДАННУЮ В ПАРАМЕТРИЧЕСКОМ ВИДЕ X=f(t),Y=g(t). КРОМЕ ГРАФИКА ВЫВЕСТИ НА ЭКРАН ОСИ КООРДИНАТ И НАЗВАНИЕ КРИВОЙ.
Кардиоида. X = a*cos(t)*(1+cos(t)),
Y = a*sin(t)*(1+cos(t)), a>0, tЄ[0,2π).
Точка пересечения осей координат должны располагаться в центре экрана. Затем
Повторить изображение кривой в 4-х точках экрана: вверху и внизу средней вертикали и слева и справа средней горизонтали, осуществив поворот осей координат на 90 градусов и сжатие по горизонтальной оси в 1.5 раза. Залить изображение жирными линиями типа \\\
и сделать анимацию движения

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Uses CRT, Graph;
Var d,dx,dy,m,i:integer; 
color,bkcolor:word;
a,x,y,o,sc,sy, t:real;
 procedure kard(x,y:real;color:word);
 Begin  setcolor(color);
 t:=0; a:=3;
While t<= 2*pi do
begin
  x:=a*cos(t-o)*(1+cos(t+o));
  y:= a * sin(t-o)*(1+cos(t+o));
  PutPixel(round(dx+(x*(15+sc))) + 320, round(dy+(y*(15+sy))) +240,color);
  t := t + 0.01;
end; end;
 
begin
InitGraph(d,m,'C:\TP7\BGI'); {указать свой путь к папке BGI с драйвером}
setfillstyle(6, 15);
dx:=0; dy:=0; sy:=0;
color:=15;bkcolor:=0;
 
while dx<=150 do
begin  setcolor(6);
  Line(0, 240, 640, 240);
  Line(320, 0, 320, 480);  {vpravo}
  outtextXY(15,450,'eTo_KAPDuouDa');
  kard(x,y,color); delay(100);kard(x,y,bkcolor);
  dx:=dx+1;o:=o+(pi/600);
  sc:=sc-(1/30);kard(x,y,color);
end; floodfill(475, 230, 15);
   dx:=0; sc:=0; o:=0;
 
while dy<=150 do 
begin setcolor(6);
  Line(0, 240, 640, 240);
  Line(320, 0, 320, 480);  {vniz}
  kard(x,y,color); delay(100);kard(x,y,bkcolor);
  dy:=dy+1;sy:=sy-(1/30); 
  kard(x,y,color); 
end;  floodfill(330, 395, 15);
   dy:=0;sy:=0;
 
while dx>=-150 do begin  setcolor(6);
  Line(0, 240, 640, 240);
  Line(320, 0, 320, 480);    {vlevo}
  kard(x,y,color); delay(100);kard(x,y,bkcolor);
  dx:=dx-1;o:=o-(pi/600);sc:=sc-(1/30);
  kard(x,y,color); 
end;floodfill(170, 250, 15);
   dx:=0;sc:=0;o:=0;
 
while dy>=-150 do begin  setcolor(6);
  Line(0, 240, 640, 240);
  Line(320, 0, 320, 480);    {vverh}
  kard(x,y,color); delay(100);kard(x,y,bkcolor);
  dy:=dy-1;o:=o+(pi/300);sy:=sy-(1/30);
  kard(x,y,color);
end;
floodfill(310, 60, 15);  dy:=0;o:=0; sy:=0;
kard(x,y,color);
floodfill(330, 250, 15);
readln;
CloseGraph;
 End.

@Puporev · 18.05.2010, 13:28

Добавлю свои 5 копеек про кардиоиду.
Рисование кардиоиды(ее геометрический смысл).

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
uses crt,graph;
type kard=record{тип запись с полями}
          x,y,{точки кардиоиды}
          x1,y1:integer;{центр движущейся окружности}
          end;
mass=array[1..700] of kard;{массив точек чуть с запасом =6.28/0.01}
{заполнение массива}
procedure Point(cx,cy,a:integer;var k:mass;var n:integer);
var t:real;
begin
n:=0;{количество точек кардиоиды}
t:=pi;{начало рисования}
while t<=3*pi do{делаем полный оборот}
 begin
  n:=n+1;
  {точки кардиоиды по параметрическому уравнению, сх, су - центр}
  k[n].x:=cx-round(2*a*cos(t)*(1+cos(t)));
  k[n].y:=cy+round(2*a*sin(t)*(1+cos(t)));
  {центр круга вычисляем}
  k[n].x1:=cx-a-round(2*a*cos(t));
  k[n].y1:=cy+round(2*a*sin(t));
  t:=t+0.01;
 end;
end;
{рисование}
procedure Kardioida(var k:mass;n,cv,cx,cy,a:integer);
var i,j:integer;
begin
i:=1;
while i<n-5 do
 begin
  {рисуем цветом фона - стираем} 
  setcolor(0);
  moveto(k[1].x,k[1].y);
  setlinestyle(0,0,1);
  {setlinestyle(0,0,3);линия толше, но сильнее мерцание}
  for j:=1 to i do
  lineto(k[j].x,k[j].y);
  setlinestyle(0,0,1);
  Circle(k[j].x1,k[j].y1,a);
  line(k[j].x1,k[j].y1,k[j].x,k[j].y);
  i:=i+5;{шаг вперед, можешь поменять}
  {рисуем в цвете} 
  setcolor(12);
  setlinestyle(0,0,1);
  {setlinestyle(0,0,3);линия толше, но сильнее мерцание}
  moveto(k[1].x,k[1].y);
  for j:=1 to i do
  lineto(k[j].x,k[j].y);{кардиоида}
  setcolor(8);
  setlinestyle(0,0,1);
  Circle(cx-a,cy,a);{неподвижная окружность}
  Circle(k[j].x1,k[j].y1,a);{подвижная}
  line(k[j].x1,k[j].y1,k[j].x,k[j].y);{линия точки движения}
  delay(50);
 end;
end;
var x0,y0,a,cv,n,i:integer;
    t:real;
    k:mass;
begin
clrscr;
{назначем радиус кардиоиды}
repeat
write('Radius [10..75] a=');
readln(a);
until a in [10..150];
x0:=0;
{переход в графический режим}
initgraph(x0,y0,'');
{белый фон}
setbkcolor(15);
{центр экрана}
x0:=getmaxX div 2;
y0:=getmaxY div 2;
Point(x0+a,y0,a,k,n);
Kardioida(k,n,12,x0+a,y0,a);
readln
end.

@1bit · 20.05.2010, 22:11

Сообщение от ЛоРД_Оледжан

Программа рисует прямоугольную спираль с начальным значением длины первых двух сторон 10 пикселей и конечными 320 с центром посередине экрана. Каждую следующею пару сторон повышать на 10%

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
program spiral;
uses graph;
const
koef=1.1; {коефициент возростания сторон}
pochatok=10;
kinec=320;
var
driver,mode:integer;
procedure Myspiral(storona:integer);
begin
if storona<=kinec then
begin
storona:=-storona; {смена направления рисования}
linerel(0,storona);    {вверх или вниз}
linerel(storona,0);    {влево или вправо}
Myspiral(round(koef*storona))
end
end;
begin
driver:=detect;
initgraph(driver,mode,' ');
setbkcolor(1);
setcolor(1);
linerel(300,240);
setcolor(15);
Myspiral(pochatok);
readln;
end.

При запуске данной програмы выскакивает следующее сообщение

Вложение 30648

В чем баг ?
.

@insolent · 20.05.2010, 23:52

1bit, там же четко написано, что не поддерживается полноэкранный режим(ты, наверно, используешь Vista или Seven). Чтобы можно было запускать DOS-программы в полноэкранном режиме нужно использовать эмуляторы DOS, например DOSBox.

@WolfCF · 22.05.2010, 07:42

красивые попугаи

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
Uses Graph;
Var gd,gm:integer;
Begin
  Initgraph (gd,gd,'');
  Setfillstyle (1,cyan);
  Floodfill (1,1,cyan);
  Setcolor (black);
  Ellipse (150,350,110,200,20,70);
  Arc (151,370,180,278,20);
  Arc (160,370,230,320,20);
  Arc (180,375,222,307,10);
  Ellipse (180,180,280,328,40,205);
  Moveto (500,309);
  Linerel (-400,-28);
  Linerel (-10,-10);
  Linerel (7,-8);
  Linerel (-8,-6);
  Linerel (6,-9);
  Linerel (-15,-5);
  Linerel (430,35);
  Linerel (-10,6);
  Linerel (7,5);
  Linerel (-8,7);
  Linerel (16,9);
  Linerel (-15,4);
  Setfillstyle (1,brown);
  Floodfill(270,275,black);
  Ellipse (260,200,100,195,120,190);
  Ellipse (240,53,0,90,50,40);
  Ellipse (290,103,0,90,60,50);
  Ellipse (341,212,330,80,60,110);
  Ellipse (350,340,290,26,30,90);
  Ellipse (330,310,172,270,30,110);
  Arc (337,413,220,320,10);
  Arc (352,418,210,320,10);
  Ellipse (320,160,150,238,50,120);
  Ellipse (230,37,275,324,50,220);
  Arc (322,110,210,330,58);
  Ellipse (400,100,190,250,30,100);
  Ellipse (375,225,290,45,20,45);
  Arc (320,220,200,270,42);
  Ellipse (270,110,100,180,25,35);
  Arc (290,78,90,173,25);
  Ellipse (271,110,90,180,25,15);
  Circle (290,75,5);
  Circle (290,75,2);
  Ellipse (261,96,220,325,17,15);
  Ellipse (255,88,340,50,17,15);
  Arc (270,100,0,90,5);
  Setfillstyle (1,red);
  Floodfill (290,100,black);
  Floodfill (320,320,black);
  Floodfill (300,259,black);
  Floodfill (400,200,black);
  Setfillstyle (1,blue);
  Floodfill (320,200,black);
  Setfillstyle (1,black);
  Floodfill (290,75,black);
  Setfillstyle (9,yellow);
  Floodfill (286,75,black);
  Setfillstyle (1,darkgray);
  Floodfill (260,80,black);
  Floodfill (260,100,black);
  Line (299,295,340,340);
  Line (340,340,375,300);
  Line (310,308,320,414);
  Line (320,318,328,420);
  Line (335,335,345,420);
  Line (350,330,350,427);
  Line (365,312,360,425);
  Ellipse (290,275,90,265,15,18);
  Ellipse (290,275,90,265,10,18);
  Ellipse (295,276,90,265,15,18);
  Ellipse (295,276,90,265,10,18);
  Ellipse (300,277,90,265,15,18);
  Ellipse (300,277,90,265,10,18);
  Ellipse (350,281,90,265,15,18);
  Ellipse (350,281,90,265,10,18);
  Ellipse (355,282,90,265,15,18);
  Ellipse (355,282,90,265,10,18);
  Ellipse (360,283,90,265,15,18);
  Ellipse (360,283,90,265,10,18);
  Floodfill (276,275,black);
  Floodfill (281,275,black);
  Floodfill (286,275,black);
  Floodfill (350,275,black);
  Floodfill (342,275,black);
  Floodfill (337,275,black);
  Circle (250,30,5);
  Circle (250,30,2);
  Setfillstyle (1,black);
  Floodfill (250,30,black);
  Setfillstyle (9,yellow);
  Floodfill (247,30,black);
  Ellipse (280,45,90,240,12,15);
  Setfillstyle (1,brown);
  Floodfill (280,35,black);
  Ellipse (190,140,290,0,15,50);
  Line (195,186,143,248);
  Ellipse (190,140,0,130,15,50);
  Ellipse (180,145,280,72,15,55);
  Ellipse (200,155,246,78,20,40);
  Ellipse (270,160,90,250,10,25);
  Ellipse (163,180,100,230,10,70);
  Ellipse (175,170,110,224,10,70);
  Ellipse (190,160,130,215,10,70);
  Setfillstyle (1,green);
  Floodfill (200,100,black);
  Setfillstyle (1,red);
  Floodfill (215,150,black);
  Floodfill (265,150,black);
  Setfillstyle (1,lightblue);
  Floodfill (200,150,black);
  Line (145,285,180,310);
  Line (180,310,210,290);
  Setfillstyle (1,white);
  Floodfill (150,286,black);
  Ellipse (166,347,200,340,38,15);
  Floodfill (150,370,black);
  Ellipse (270,65,31,90,10,15);
  Setfillstyle (1,lightblue);
  Floodfill (150,300,black);
  Line (155,292,148,385);
  Line (165,300,160,390);
  Line (180,310,173,382);
  Line (195,300,188,380);
  Ellipse (240,273,270,90,15,18);
  Ellipse (240,273,270,90,10,18);
  Ellipse (235,272,270,90,15,18);
  Ellipse (235,272,270,90,10,18);
  Ellipse (230,271,270,90,15,18);
  Ellipse (230,271,270,90,10,18);
  Ellipse (195,270,270,90,15,18);
  Ellipse (195,270,270,90,10,18);
  Ellipse (190,269,270,90,15,18);
  Ellipse (190,269,270,90,10,18);
  Ellipse (185,268,270,90,15,18);
  Ellipse (185,268,270,90,10,18);
  Setfillstyle (1,darkgray);
  Floodfill (197,268,black);
  Floodfill (202,269,black);
  Floodfill (207,270,black);
  Floodfill (241,271,black);
  Floodfill (246,272,black);
  Floodfill (251,273,black);
  Settextstyle (0,0,1);
  Readln;
  Closegraph;
End.

Не по теме:

программа не моя

@Puporev · 22.05.2010, 07:56

Не по теме:

Да уж.... это ж сколько времени нужно чтобы все координаты подогнать...

@Rom@ · 27.05.2010, 21:55

незнаю может такое уже было
красивая програмка по графике
Программа просто !!!BOMBA!!! Короче, программа рисует анимацию вращение Земли вокруг Солнца и вокруг центра галактики. Лучше посмотрите сами.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Program Space;             
   Uses Graph, Crt;
   Const
     RadOrb = 250 ;  RadSun = 70 ;
     RadGal = 100 ;  RadZem = 18 ;
     Naklon = 0.2;
     PressZem = 0.65;
     Compress = 0.8;
                          
   Var
     ZemX, ZemY, UgMer,  PixelY,  DUgZem ,  UpDown,
     XRad, Grad, UgZem,  PixelX,  StAngle,  Ua, Ub,
     ParallelY,  Color,  ZemPix,  EndAngle,
     VisualPage, GrMode, GrError, GrDriver, i : Integer;
     Ugol,  CompressZem, Expansion,
     DUgol, Projection,  PolUgol              : Real;
 BEGIN
            
   GrDriver := EGA; GrMode := EGAHi;
   InitGraph(GrDriver, GrMode, 'C:\TP\BGI');
   GrError := GraphResult; If GrError<>GrOk then Halt;
 
   SetBkColor(Black);
   SetFillStyle(1, Yellow); 
   Ugol := 0; DUgol := 2*Pi/180;
   UgZem := 0; DUgZem := 14;    
      
   VisualPage := 1;
   Repeat                    
     SetVisualPage(1- (VisualPage mod 2));
                              
     VisualPage := VisualPage+1;                
     SetActivePage(1 - (VisualPage mod 2));
                 
                
     ClearDevice;                        
   
   
     RandSeed:=1;         
     Expansion:=VisualPage/100;
     For i:= 1 to VisualPage do
       begin XRad := Trunc(Expansion*RadGal*Random);
              
          PolUgol:= 2*Pi*Random-VisualPage/30;
               
          PixelX := 370+Trunc(XRad*cos(PolUgol+1.8)); 
          PixelY := 250+Trunc(XRad*0.5*sin(PolUgol)); 
          PutPixel(PixelX, PixelY, White)          
       end;
      
     {Рисование мерцающих звезд}
     Randomize;            
 
     For i:=1 to 70 do
       PutPixel(Random(640),Random (350),White);
           
     For i := 1 to 100 do               
       PutPixel(320+Round(RadOrb * cos((i+VisualPage/5)*Pi/50+0.3)),
       160+Round(RadOrb*Naklon*sin((i+VisualPage/5)*Pi/50-Pi/2)),15);
       
     PieSlice(310, 160, 0, 360, RadSun); 
       
  
     Ugol := Ugol+DUgol ;      
     Grad := Round(180*Ugol/Pi) mod 360;  
     ZemX := 320+Round(RadOrb*cos((Ugol+Pi/2+0.3))); 
     ZemY:=160+Round(RadOrb*Naklon*sin(Ugol));        
     CompressZem := 2.5-cos(Ugol+0.3);
               
     ZemPix := Round(RadZem*CompressZem);         
     UgZem := UgZem+DUgZem; 
 
     For i := 0 to 11 do             
      begin
       UgMer := (UgZem+i*30) mod 360;
       If (90<UgMer) and (UgMer<270) 
         then begin StAngle := 90; EndAngle := 270 end    
         else begin StAngle := 270; EndAngle := 90 end;
       Ua := (Grad+220) mod 360; Ub := (Grad+400) mod 360;
                 
                   
       Color := LightBlue;
       If Ua<=Ub then if (Ua<UgMer) and (UgMer<Ub) then Color := White;
       If Ua >Ub then if (Ua<UgMer) or  (UgMer<Ub) then Color := White;
       SetColor(Color);
       XRad := round((ZemPix*cos(UgMer*Pi/180)));
       Ellipse(ZemX,ZemY,StAngle,EndAngle,abs(XRad),round(PressZem*ZemPix));
      end;
 
     For i := 2 to 7 do        
       begin
         XRad := abs(Round(ZemPix*sin(i*Pi/9)));
                                
         UpDown := Round(ZemPix*PressZem*cos(i*Pi/9));
                              
         ParallelY := ZemY+UpDown;
         SetColor(LightBlue);
         Ellipse(ZemX, ParallelY, 0, 360, XRad, Round(Naklon*XRad));
                               
         SetColor(White);
         Ellipse(ZemX,ParallelY,Grad+220,Grad+400,XRad,Round(Naklon*XRad));
                               
       end;
           
   
     If CompressZem<2 then PieSlice(310, 160, 0, 360, RadSun);
           
     RandSeed := VisualPage mod 12;
     For i := 1 to 250 do                      
       begin
          Projection := (1-sqr(Random))*Pi/2;
          XRad := RadSun+Round((20)*sin(Projection))-15;
          PolUgol := 2 * Pi * Random+VisualPage/20;
                        
          PixelX := 310 + Round( XRad * cos(PolUgol));
          PixelY := 160 + Round( Compress * XRad * sin(PolUgol));
          PutPixel(PixelX, PixelY, LightRed)
       end;
   until KeyPressed
 END.

@Sasha123 · 30.05.2010, 19:23

Построение Т-образного дерева со случайным расположением веток

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
program Fractal;
uses graph;
 
function ttree(rx, ry, d1, d2, count: integer): integer;
var z: integer;
begin
if count=0 then ttree:=0
else
 begin
 z:=random(100);
 if z<=50 then z:=1
 else z:=-1;
 line(rx, ry, rx, (ry-z*d1));
 line((rx-d2),(ry-z*d1),(rx+d2), (ry-z*d1));
 dec(count);
 ttree:=ttree((rx-d2),(ry-z*d1), d1 div 2, d2 div 2, count);
 ttree:=ttree((rx+d2),(ry-z*d1), d1 div 2, d2 div 2, count);
 end;
end;
 
var gd, gm: integer;
begin
gd:=VGA;
gm:=VGAHi;
initgraph(gd,gm,'../bgi');
ttree(300,400,200,90,10);
readln;
end.

Добавлено через 3 часа 18 минут
заполнение экрана правильными шестиугольниками трёх цветов

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
uses crt,graph;
var
 i:byte;
 l,h:integer;
 gd,gm:integer;
procedure draw_6(x,y:integer;c:byte);
var tx,ty:array[1..6] of integer;
i:byte;
begin
for i:=1 to 6 do
 begin
  tx[i]:=round(x+75*sin(pi*(i*60-30)/180));
  ty[i]:=round(y+75*cos(pi*(i*60-30)/180))
 end;
 setcolor(c);
for i:=1 to 5 do
 line(tx[i],ty[i],tx[i+1],ty[i+1]);
 line(tx[6],ty[6],tx[1],ty[1]);
 setfillstyle(1,c);
 floodfill(x,y,c);
 floodfill(x+70,y,c);
 floodfill(x,y-h+5,c);
 l:=tx[3]-tx[4];
end;
begin
 gd:=installuserdriver('svga256',nil);
 gm:=2;
 initgraph(gd,gm,'');
for i:=0 to 2 do
 draw_6(65+i*(l+150),65,white);
h:=round(sqrt(75*75-(l/2)*(l/2)));
for i:=0 to 3 do
 draw_6(round(-15-l/2)+i*(l+150)+4-3*(i div 3),65-h,lightgray);
for i:=0 to 3 do
 draw_6(round(-15-l/2)+i*(l+150)+4-3*(i div 3),65+h,darkgray);
for i:=0 to 2 do
 draw_6(65+i*(l+150),65+2*h,lightgray);
for i:=0 to 3 do
 draw_6(round(-15-l/2)+i*(l+150)+4-3*(i div 3),65+3*h,white);
for i:=0 to 2 do
 draw_6(65+i*(l+150),65+4*h,darkgray);
for i:=0 to 3 do
 draw_6(round(-15-l/2)+i*(l+150)+4-3*(i div 3),65+5*h,lightgray);
for i:=0 to 2 do
 draw_6(65+i*(l+150),65+6*h,white);
for i:=0 to 3 do
 draw_6(round(-15-l/2)+i*(l+150)+4-3*(i div 3),65+7*h,darkgray);
 readkey;
end.

Добавлено через 2 минуты
Получение фигуры с помощью превращений, масштабирования и поворота.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
uses graph;
procedure Figura(x1,y1,d,m,u,c:integer);
{x1,y1-координаты центра, d-радиус=размер фигуры, 
m-во сколько раз внутренний радиус меньше внешнего
u-начальный угол построения, с-цвет фигуры}
var a,i,d1:integer;
    p:array[1..9] of pointtype;{полигон-массив координат вершин}
begin
d1:=d div m;{внутренний радиус}
a:=u;{}
for i:=1 to 8 do{определяем координаты вершин}
  begin
    if i mod 2=0 then{внешние}
      begin
        p[i].x:=x1+round(d*cos(a*pi/180));{большой радиус}
        p[i].y:=y1-round(d*sin(a*pi/180));
      end
    else{внутренние}
      begin
        p[i].x:=x1+round(d1*cos(a*pi/180));{малый радиус}
        p[i].y:=y1-round(d1*sin(a*pi/180));
      end;
    a:=a+45;{наращиваем угол}
  end;
p[9].x:=p[1].x;{замыкаем полигон}
p[9].y:=p[1].y;
MoveTo(p[1].x,p[1].y);{в первую вершину}
SetColor(c);{выбираем цвет}
for i:=1 to 9 do
LineTo(p[i].x,p[i].y);{соединяем вершины}
Setfillstyle(1,c);{стиль закраски}
floodfill(x1,y1,c);{закрашиваем}
end;
var gd,gm,xc,yc:integer;
begin
gd:=0;
initgraph(gd,gm,'');
xc:=getmaxX div 2;
yc:=getmaxY div 2;
Figura(xc,yc,120,5,-45,9);{первая фигура}
Figura(xc,yc,80,8,0,1);{вторая, параметры сами подбирайте}
readln
end.

@Джексон · 31.05.2010, 14:19

вот код програмы движения курсора по экрану с помощью стрелок, надеюсь комуто пригодится)))

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
uses Crt,Graph;
   var p,pc: Pointer;
     grm,grd,x,y,x0,y0,lx,ly,hx,hy:integer;
     size,c:word; ch:char;
   BEGIN
      lx:=11;ly:=11;   {storonu kursora}
      hx:=5; hy:=5;      
      grd:=0; InitGraph (grd,grm,'D:\Tp\Bgi');
      size:=ImageSize (0,0,lx,ly);
      GetMem (pc,size); GetMem (p,size);
      SetFillStyle (1,2);
      GetImage (0,0,lx,ly,p^);
      x:=0; y:=0;
      bar(0,0,lx,ly); {kursor}
      GetImage (0,0,lx,ly,pc^);
      SetFillStyle (1,4);
      bar(200,0,300,100);{proverochnuy kvadrat}
      Repeat
         ch:=ReadKey;
         If  Ord(ch)=0
            then
             begin
              ch:=ReadKey;
              x0:=x; y0:=y;
              Case  Ord(ch)  of
               77: If  x<getmaxx-hx
                    then x:=x+hx;
               75: If  x>hx
                    then  x:=x-hx;         
               72: If  y>hy
                    then  y:=y-hy;
               80: If  y<getmaxy-hy
                    then  y:=y+hy
              end;
 
          If  (x<>x0) OR (y<>y0)
            then  begin
                  PutImage (x0,y0,p^,0);
                  GetImage (x,y,x+lx,y+ly,p^);
                  PutImage (x,y,pc^,0);
                  end
             end
        else if ord(ch)=32 then
                           for x:=x to x+4 do
                            begin
                            x0:=x; y0:=y;
                            PutImage (x0,y0,p^,0);
                            GetImage (x,y,x+lx,y+ly,p^);
                            PutImage (x,y,pc^,0);
 
                            end;
      until  Ord(ch)=27;
      CloseGraph
   END.

я сам использовал этот код как заготовку для игор!)))

@AnDrew_LP · 31.05.2010, 20:00

Игра написанная мной на Паскале)
Мне 14 лет, не судите строго https://www.cyberforum.ru/atta... 1275320306

@Puporev · 31.05.2010, 20:40

Еще бы узнать в чем суть игры?

@WolfCF · 01.06.2010, 05:08

Puporev, всё просто, на самсунгах раньше была такая игра, называлась хомячки вроде.
надо обрезать черное поле своим квадратом и чтобы шары тебя не задели.

01.06.2010, 12:59

как тут файлы заливать я не знаю, первый раз тут. Вот ехешники моих игр. http://rapidshare.com/files/39... 3.rar.html

@WolfCF · 01.06.2010, 13:01

Dontre, для кого было написано, прочитайте поймете

Новые блоги и статьи Все статьи Все блоги /
Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .
Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025	Расскажи мне о Мире, бродяга kumehtar 12.11.2025 — Расскажи мне о Мире, бродяга, Ты же видел моря и метели. Как сменялись короны и стяги, Как эпохи стрелою летели. - Этот мир — это крылья и горы, Снег и пламя, любовь и тревоги, И бескрайние. . .

@Puporev
	26.04.2010, 06:16
	Не по теме: Wolf, Ну там еще стандартную проверку на ошибку инициализации графического режима пишут, а это уже где-то 6-7 строк. 0

@Puporev Почетный модератор 64314 / 47610 / 32743 Регистрация: 18.05.2008 Сообщений: 115,168
	02.05.2010, 06:16
	STGE, Нужно доделать. Юзер должен задавать поле, программа рисовать. И все таки ферзя то нужно нарисовать, а не пустое поле. 0

@insolent 829 / 353 / 64 Регистрация: 30.01.2009 Сообщений: 1,204
	17.05.2010, 22:51
	Мой вариант старой игры "Змейка". Условие всем известны: змея ползает по полю и кушает яблоки, при съедении яблока увеличивается. Вложение 30283 Код немного сыроват и нуждается в дальнейшем доработке. Код разбит на модули. Также в архиве шрифт и видеодрайвер. ЗЫЖ Небольшой нюанс: нужно выбрать оптимальное значение передаваемое Delay. 0

@insolent 829 / 353 / 64 Регистрация: 30.01.2009 Сообщений: 1,204
	20.05.2010, 23:52
	1bit, там же четко написано, что не поддерживается полноэкранный режим(ты, наверно, используешь Vista или Seven). Чтобы можно было запускать DOS-программы в полноэкранном режиме нужно использовать эмуляторы DOS, например DOSBox. 0

@Puporev
	22.05.2010, 07:56
	Не по теме: Да уж.... это ж сколько времени нужно чтобы все координаты подогнать... 0

@AnDrew_LP 162 / 162 / 42 Регистрация: 29.05.2010 Сообщений: 435
	31.05.2010, 20:00
	Игра написанная мной на Паскале) Мне 14 лет, не судите строго https://www.cyberforum.ru/atta... 1275320306 0

@Puporev Почетный модератор 64314 / 47610 / 32743 Регистрация: 18.05.2008 Сообщений: 115,168
	31.05.2010, 20:40
	Еще бы узнать в чем суть игры? 0

@WolfCF 3316 / 1378 / 110 Регистрация: 28.04.2009 Сообщений: 4,822
	01.06.2010, 05:08
	Puporev, всё просто, на самсунгах раньше была такая игра, называлась хомячки вроде. надо обрезать черное поле своим квадратом и чтобы шары тебя не задели. 0

Dontre
	01.06.2010, 12:59
	как тут файлы заливать я не знаю, первый раз тут. Вот ехешники моих игр. http://rapidshare.com/files/39... 3.rar.html

@WolfCF 3316 / 1378 / 110 Регистрация: 28.04.2009 Сообщений: 4,822
	01.06.2010, 13:01
	Dontre, для кого было написано, прочитайте поймете 0