Графика в Турбо Паскаль - 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, для кого было написано, прочитайте поймете

Новые блоги и статьи Все статьи Все блоги /
Когда логика программы не спасает от человеческих ошибок Maks 18.08.2026 В последнее время всё чаще и чаще сталкиваюсь с таким явлением, как абсолютная невнимательность (или глупость) пользователей. Проявляется это чаще всего на работе в коллективе. Допустим, человек с. . .	Лето уходит kumehtar 17.08.2026	Мысли в слух kumehtar 17.08.2026 Забавно, насколько сейчас стала доступна информация. Например о магии, духовном развитии, медитациях, и других подобных направлениях, ранее зачастую тайных, передаваемых от учителя к ученику. Хотя. . .	Перемещение строк из ТЧ в другой документ с учетом текущего пробега Maks 17.08.2026 Реализация из решения ниже выполнена на примере нетипового документа "Автозапчасти", с ТЧ "Шины". За основу взят алгоритм отсюда: https:/ / www. cyberforum. ru/ blogs/ 359708/ 10838. html Задача: . . .
Саморегулирующийся социальный контракт для сервера cross-section. Hrethgir 14.08.2026 С кодом конечно таких глубоких размышлений пока не было, впрочем я уже привык к алгоритмизации. Суть предмета записи: снова в диалоге с нейросетью (я взял пока себе ник для учётки админа - Rector). . . .	Часы электронные Uhbif79 12.08.2026 Выкладываю программу часов. Программа позволяет: 1. Использовать системное время и дату, 2. Есть возможность вводить время и дату вручную. 3. Реализованы 2 будильника: начало и конец рабочего дня. . . .	Часы с будильником на основе класса QLCDNumber Uhbif79 12.08.2026 Всем добрый день, выкладываю программу часов с будильником на основе класса QLCDNumber. Здесь я пробовал самостоятельно создавал классы, впервые столкнулся с видимостью переменной одного класса из. . .	Установка MinGW GCC 16.2 и CMake 8Observer8 10.08.2026 VK Видео: https:/ / vkvideo. ru/ video-240781534_456239017 YouTube: eY5-5PyI9NM Текстовая версия

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

@Puporev Почетный модератор 64320 / 47616 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	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 Почетный модератор 64320 / 47616 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	31.05.2010, 20:40
	Еще бы узнать в чем суть игры? 0

@WolfCF 3319 / 1381 / 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 3319 / 1381 / 110 Регистрация: 28.04.2009 Сообщений: 4,822
	01.06.2010, 13:01
	Dontre, для кого было написано, прочитайте поймете 0