IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> помогите вращение окружности, 1
сообщение
Сообщение #1


Гость






как сделать вращение окружности... !! на pascal, пример колесо от велосипеда
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


поиск
****

Группа: Пользователи
Сообщений: 347
Пол: Мужской
Реальное имя: nir

Репутация: -  2  +


Каламбур и бред в коду, бузумство копирования и непристойность стиля : у тебя эту прогу наверное не возьмут.
Но у меня приступ альтруизма smile.gif .

program arci;

uses graph, crt, unitlinkedList ;

const

krug = 6.3 ;
grDriver : integer = Detect ;

var

l, l1 : linkList ;
Colvo, grMode : integer ;
Npoint1, Npoint2 : integer ;
cer : real ;
stepAlfa, alfa : real ;
i, max, time : integer ;

x , y : integer ;
x0 , y0 : integer ;

x1, y1,xx,yy,j : integer ;
{****************************************************************}

procedure raspolog (const col : integer ;
const cer , stepalfa : real ) ;

const
krug = 6.3 ;

var

x0, y0, x, y, x1, y1,xx,yy : integer ;
alfa : real ;
i : integer ;
// stro : string ;

begin


alfa := 0 ;
x0 := getmaxx div 4 ;
y0 := getmaxy div 2 ;
// stepAlfa := krug / col ;
alfa := alfa + stepAlfa ;

x := round(x0 + cos ( alfa ) * cer ) ;
y := round(y0 + sin ( alfa ) * cer ) ;
line(x0, y0, x, y);

xx := (getmaxx div 4) * 3 ;
yy := y0 ;

x1 := round(xx + cos ( alfa ) * cer ) ;
y1 := round(yy + sin ( alfa ) * cer ) ;
line(xx, yy, x1, y1);


// Arc(x,y,0,360,1);
// outtextXY(x, y,'0');


L.Init(0, x, y) ;
l1.Init(0, x1, y1);


for i := 1 to col-1 do
begin

alfa := alfa + stepAlfa ;

x := round(x0 + cos ( alfa ) * cer ) ; //ключевая формула ей надо use если точки ориентированы вокруг оси
y := round(y0 + sin ( alfa ) * cer ) ; // alfa = angle(rad) ; cer = length from center

x1 := round(xx + cos ( alfa ) * cer ) ;
y1 := round(yy + sin ( alfa ) * cer ) ;

l.AddInEnd(x,y);
line(x0, y0, x, y);

l1.AddInEnd(x1,y1);
line(xx, yy, x1, y1);
// str(i, stro ) ;
// outtextXY(x, y,stro);
// Arc(x,y,0,360,1);

end ;

end ;
{********************************************************************}

{--main programm ------------------------------}

Begin
clrscr ;

InitGraph (grDriver, grMode, '') ;

write('Введите кол во базовых точек '); readln(Colvo);
write('Расстояние от центра '); readln(cer) ;
write('delay - ') ; readln(time) ;
write('links 1, recht 2 '); readln(j);

stepAlfa := krug / colvo ;

raspolog(ColVo, Cer, stepalfa) ;

x0 := getmaxx div 4 ;
y0 := getmaxy div 2 ;

xx := (getmaxx div 4) * 3 ;
yy := y0 ;

arc(x0, y0, 0, 360,round(cer));
arc(xx, yy, 0, 360,round(cer));

readkey ;

while true do
begin

{ write('Enter number 1 point '); readln(npoint1) ;
write('2 point '); readln(Npoint2);

l.extrackt(Npoint1, x1, y1);
l.extrackt(Npoint2, x2, y2);
line(x1,y1,x2,y2); }
max := l.richtkey ;
arc(x0, y0, 0, 360,round(cer));
arc(xx, yy, 0, 360,round(cer));
// writeln(max);

for i := 0 to max do begin
if j = 1 then
alfa := alfa + stepalfa + 0.1
else alfa := alfa + stepalfa - 0.1 ;
// delay(100);
l.extrackt(i, x, y);
setcolor(0);
line(x0, y0, x, y);
x := round(x0 + cos ( alfa ) * cer ) ;
y := round(y0 + sin ( alfa ) * cer ) ;
setcolor(15);
line(x0, y0, x, y);
l.delbykey(i);
l.addinend(x,y);
end ;

max := l1.richtkey ;
for i := 0 to max do begin
if j = 1 then
alfa := alfa + stepalfa + 0.1
else alfa := alfa + stepalfa - 0.1 ;
// delay(100);
l1.extrackt(i, x1, y1);
setcolor(0);
line(xx, yy, x1, y1);
x1 := round(xx + cos ( alfa ) * cer ) ;
y1 := round(yy + sin ( alfa ) * cer ) ;
setcolor(15);
line(xx, yy, x1, y1);
l1.delbykey(i);
l1.addinend(x1,y1);
end ;



delay(time);

end ;

readln ;

end .



Добавлено через 10 мин.
если хочешь про вращение вправо влево менять динамически то сделая переменную bool и меняй направление
вз от ее значения ввод с клавы не останавливая прорисрвку

procedure cursor_keys ;

var

key : char ;

begin

if keypressed then begin
key := readkey ;
case ord(key) of /// коды клавишь и дейсвия
45 : ....
34: ....

end ;

end ;
end ;



Сообщение отредактировано: renesko1 -


--------------------
typedef void Śūnyatā ;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 10.09.2025 12:10
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name