Форум программистов, компьютерный форум, киберфорум
Наши страницы

Turbo Pascal

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 1, средняя оценка - 5.00
Puporev
26.04.2010, 06:16     Графика в Турбо Паскаль
  #61

Не по теме:

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

0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
26.04.2010, 06:16
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Графика в Турбо Паскаль (Turbo Pascal):

Графика в Турбо Паскаль - Turbo Pascal
(b+\sqrt{b-4ac}/2a)-a*a*a*c - помогите как это записать в турбо паскале напишите кто нить полную программу пожалуйста!

Графика в Турбо Паскаль - Turbo Pascal
Не могли бы вы посоветовать книгу или дать ссылку на форуме где подробно описана работа с графикой , особенно рисовка движения разными...

Графика в Турбо Паскаль - Turbo Pascal
ситуация следующая. написала програму в которой задаешь координаты точки и в зависимости от ее места нахождения в фигуре закрашеной или не...

Графика в Турбо Паскаль не работает - Turbo Pascal
Люди помогите плиз. У меня windows 7 когда я пытаюсь запустить программу с модулем graph, на Turbo pascal, то он мне выдает ошибку...

построение графика на Турбо Паскаль - Turbo Pascal
Помогите пожалуйста Y=(x*(3-x))/(1-x)*sqr(1-x)

Построение графика функции в турбо-Паскаль - Turbo Pascal
Как построить график данной функции в паскаль?(2*(1+0.7*(sin(10^7*t))*(sin(10^8*t))

157
WolfCF
3284 / 1345 / 47
Регистрация: 28.04.2009
Сообщений: 4,823
30.04.2010, 06:08 #62
Полет космического корабля до конца экрана с использованием динамической памяти.

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.
0
STGE
770 / 575 / 91
Регистрация: 17.06.2009
Сообщений: 1,188
02.05.2010, 01:12 #63
Положение ударных позиций ферзи:
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.
0
Puporev
Модератор
52415 / 40262 / 13596
Регистрация: 18.05.2008
Сообщений: 93,073
02.05.2010, 06:16 #64
STGE, Нужно доделать. Юзер должен задавать поле, программа рисовать. И все таки ферзя то нужно нарисовать, а не пустое поле.
0
Кетя
1 / 1 / 0
Регистрация: 16.05.2010
Сообщений: 17
16.05.2010, 17:52 #65
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.
0
insolent
826 / 344 / 15
Регистрация: 30.01.2009
Сообщений: 1,204
17.05.2010, 22:51 #66
Мой вариант старой игры "Змейка". Условие всем известны: змея ползает по полю и кушает яблоки, при съедении яблока увеличивается.

Вложение 30283

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

ЗЫЖ Небольшой нюанс: нужно выбрать оптимальное значение передаваемое Delay.
0
Euronymous
1 / 1 / 0
Регистрация: 30.04.2010
Сообщений: 10
18.05.2010, 13:21 #67
вот мой курсач на паскале. задание:
вувести НА ЭКРАН ЛИНИЮ, ЗАДАННУЮ В ПАРАМЕТРИЧЕСКОМ ВИДЕ 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.
0
Puporev
Модератор
52415 / 40262 / 13596
Регистрация: 18.05.2008
Сообщений: 93,073
18.05.2010, 13:28 #68
Добавлю свои 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.
0
1bit
0 / 0 / 0
Регистрация: 20.05.2010
Сообщений: 8
20.05.2010, 22:11 #69
Цитата Сообщение от ЛоРД_Оледжан Посмотреть сообщение
Программа рисует прямоугольную спираль с начальным значением длины первых двух сторон 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

В чем баг ?
.
0
insolent
826 / 344 / 15
Регистрация: 30.01.2009
Сообщений: 1,204
20.05.2010, 23:52 #70
1bit, там же четко написано, что не поддерживается полноэкранный режим(ты, наверно, используешь Vista или Seven). Чтобы можно было запускать DOS-программы в полноэкранном режиме нужно использовать эмуляторы DOS, например DOSBox.
0
WolfCF
3284 / 1345 / 47
Регистрация: 28.04.2009
Сообщений: 4,823
22.05.2010, 07:42 #71
красивые попугаи
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.

Не по теме:

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

1
Puporev
22.05.2010, 07:56
  #72

Не по теме:

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

0
Rom@
22 / 22 / 3
Регистрация: 29.11.2009
Сообщений: 210
27.05.2010, 21:55 #73
незнаю может такое уже было
красивая програмка по графике
Программа просто !!!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.
1
Sasha123
12 / 11 / 0
Регистрация: 14.05.2010
Сообщений: 28
30.05.2010, 19:23 #74
Построение Т-образного дерева со случайным расположением веток
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.
0
Джексон
4 / 4 / 1
Регистрация: 31.05.2010
Сообщений: 16
31.05.2010, 14:19 #75
вот код програмы движения курсора по экрану с помощью стрелок, надеюсь комуто пригодится)))


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.
я сам использовал этот код как заготовку для игор!)))
0
31.05.2010, 14:19
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
31.05.2010, 14:19
Привет! Вот еще темы с ответами:

Графика в Турбо Паскаль. Нарисовать телефон - Turbo Pascal
Кто может нарисовать такое??

Графика в Турбо Паскаль. Нарисовать мобильный телефон - Turbo Pascal
Помогите написать графику.Нужно нарисовать мобильный телефон

Графика в Турбо Паскаль. Нарисовать флаг Македонии - Turbo Pascal
Помогите пожалуста, нужно нарисовать флаг Македонии у паскале.

Графика в Турбо Паскаль. Разносторонний треугольник, вращающийся вокруг центра тяжести - Turbo Pascal
Изобразить на экране разносторонний треугольник, вращающийся вокруг центра тяжести в плоскости экрана. Центр тяжести это точка...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
75
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru