Форум программистов, компьютерный форум, киберфорум
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.50/8: Рейтинг темы: голосов - 8, средняя оценка - 4.50
16 / 16 / 16
Регистрация: 05.06.2009
Сообщений: 47
1

Как сделать заливку шара

11.06.2009, 21:45. Показов 1642. Ответов 4
Метки нет (Все метки)

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
Uses Graph,crt;
 
Var grDriver : Integer;
      grMode : Integer;
     ErrCode : Integer;
     {----------------}
     x,y:integer;
     i,k,l:integer;
     x1,x2,y1,y2:integer;
     a,b,r:integer;
     f:boolean;
Begin
  grDriver:=Detect;
  InitGraph(grDriver, grMode, 'e:\tp\bgi');
  ErrCode:=GraphResult;
  x:=getmaxx div 2;
  y:=getmaxy div 2;
  a:=random(4);
  b:=random(4);
  a:=0;
  b:=0;
  r:=500;
  x1:=getmaxx div 2;
  y1:=getmaxy div 2;
  while not keypressed do
  begin
  f:=true;
    if (a=0) and (b=0) then
                       while (f<>false) do
                       begin
                         if (x1-31<0) or (y1-31<0) or (x1-30>getmaxx) or (y1-30>getmaxy)
                         then begin f:=false;break;end;
                         if ((x1+30)=getmaxx) or ((y1+30)=getmaxy) then begin f:=false;break;end;
                         x1:=x1+1;
                         y1:=y1+1;
                         delay(r);
                         circle(x1,y1,30);
                         delay(r);
                         cleardevice;
                       end;
    if (a=1) and (b=0) then
                       while (f<>false) do
                       begin
                       if (x1+30<0) or (y1+30<0) or (x1-30>getmaxx) or (y1-30>getmaxy)
                         then begin f:=false;break;end;
                         if ((y1+30)=getmaxy) then begin f:=false;break;end;
                         y1:=y1+1;
                         delay(r);
                         circle(x1,y1,30);
                         delay(r);
                         cleardevice;
                       end;
    if (a=0) and (b=1) then
                       while (f<>false) do
                       begin
                       if (x1+30<0) or (y1+30<0) or (x1-30>getmaxx) or (y1-30>getmaxy)
                         then begin f:=false;break;end;
                         if ((x1+30)=getmaxx) then begin f:=false;break; end;
                         x1:=x1+1;
                         delay(r);
                         circle(x1,y1,30);
                         delay(r);
                         cleardevice;
                       end;
   if (a=1) and (b=1) then
                       while (f<>false) do
                       begin
                       if (x1-30=0) or (y1-30=0)
                         then begin f:=false;break;end;
                         if ((y1-30)=0) or ((y1-30)=0) then begin f:=false;break; end;
                         y1:=y1-1;
                         x1:=x1-1;
                         delay(r);
                         circle(x1,y1,30);
                         delay(r);
                         cleardevice;
                       end;
   if (a=2) and (b=1) then
                       while (f<>false) do
                       begin
                       if (x1+30<0) or (y1+30<0) or (x1-30>getmaxx) or (y1-30>getmaxy)
                         then begin f:=false;break;end;
                         if ((y1-30)=0) then begin f:=false;break; end;
                         y1:=y1-1;
                         delay(r);
                         circle(x1,y1,30);
                         delay(r);
                         cleardevice;
                       end;
   if (a=1) and (b=2) then
                       while (f<>false) do
                       begin
                       if (x1+30<0) or (y1+30<0) or (x1-30>getmaxx) or (y1-30>getmaxy)
                         then begin f:=false;break;end;
                         if ((x1-30)=0)  then begin f:=false;break; end;
                         x1:=x1-1;
                         delay(r);
                         circle(x1,y1,30);
                         delay(r);
                         cleardevice;
                       end;
   if (a=3) and (b=2) then
                       while (f<>false) do
                       begin
                       if (x1+30<0) or (y1+30<0) or (x1-30>getmaxx) or (y1-30>getmaxy)
                         then begin f:=false;break;end;
                         if ((x1-30)=0) or ((y1+30)=getmaxy) then begin f:=false;break;  end;
                         y1:=y1+1;
                         x1:=x1-1;
                         delay(r);
                         circle(x1,y1,30);
                         delay(r);
                         cleardevice;
                       end;
   if (a=2) and (b=3) then
                       while (f<>false) do
                       begin
                       if (x1+30<0) or (y1+30<0) or (x1-30>getmaxx) or (y1-30>getmaxy)
                         then begin f:=false;break;end;
                         if ((x1+30)=getmaxx) or ((y1-30)=0) then begin f:=false;break;  end;
                         y1:=y1-1;
                         x1:=x1+1;
                         delay(r);
                         circle(x1,y1,30);
                         delay(r);
                         cleardevice;
                       end;
 
  a:=random(4);
  b:=random(4);
  end;
  closegraph;
End.
Добавлено через 43 секунды
как сделать заливку шара,помогите пожалуйста?
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
11.06.2009, 21:45
Ответы с готовыми решениями:

Составить программу, которая рисует домик. Радиус ввести с клавиатуры.Сделать заливку фигур
program PROG2; uses GraphABC; const w=5; begin SetWindowSize(256,256);...

Модуль Graph, как сделать заливку фигуры
помогите залить фигуру созданую из 4 линий: line(120,50,180,50); line(180,50,180,60);...

Как сделать так, чтобы тело двигалось по линии шара?
Как сделать так, чтобы тело двигалось по линии шара? плиз

Как сделать заливку прямоугольника?
Private Sub frm3DFigure_Paint(ByVal sender As Object, ByVal e As...

4
Модератор
63890 / 47368 / 32661
Регистрация: 18.05.2008
Сообщений: 114,899
11.06.2009, 21:58 2
Лучший ответ Сообщение было отмечено как решение

Решение

Напиши везде, где есть circle, так
Pascal
1
2
3
4
5
6
delay(r);
setcolor(11);
circle(x1,y1,30);
 setfillstyle(1,11);
 Fillellipse(x1,y1,30,30);
 delay(r);
Наворотить такое, чтоб кружок мигал, это уметь надо. Интересно бы узнать как остановить сие чудное мигание.
0
16 / 16 / 16
Регистрация: 05.06.2009
Сообщений: 47
11.06.2009, 23:20  [ТС] 3
спасибо большое
0
Маринас
04.12.2013, 22:29 4
а что за среда? freepascal?
Модератор
63890 / 47368 / 32661
Регистрация: 18.05.2008
Сообщений: 114,899
05.12.2013, 10:38 5
Вообще написано в Турбо Паскаль, но и Фрее должно работать.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
05.12.2013, 10:38

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Как сделать заливку области цветом?
Добрый день, подскажите пожалуйста как можно осуществить сабж? Например, имеется цветочек (как в...

Как сделать градиентную заливку формы
Доброго. Старики, которые помнят vb6, наверняка знали такую штуку Dim lY As Long Dim...

как сделать заливку поверхности прозрачной?
Перерыла весь редактор - там можно либо изменять палитру либо закрашивать все в однотонный цвет от...

Как сделать заливку фигуры по клику мыши?
Добрый день) Мне надо сделать заливку фигур по клику мыши. Смотрела алгоритмы заливки, но так...


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

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

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