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

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

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

> атом, проверьте
сообщение
Сообщение #1


Я.
****

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

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


визуализация атома.
подскажите пожалуйста:
1. как ускорить прогу;
2. при старте остаются следы електронов - как их убрать.

uses crt,graph;

const
re=5;
rp=15;
a=40;
b=100;
cx=320;
cy=240;
kel=10;
kor=15;
kpr=13;
z1=0;
z2=110;
z3=50;
z4=230;

var
ugol:integer;
p:pointer;
xn,yn:integer;

procedure initialization; var gd,gm:integer; begin gd:=detect; initgraph(gd,gm,''); end;

procedure vihod;
var c:char;
begin
if keypressed then begin
c:=readkey;
if c=#13 then begin
dispose(p);
closegraph;
halt;
end;
end;
end;

procedure ell(angl:real);
var x0,y0,xn,yn:real; i:integer;
begin
setcolor(kor);
for i:=0 to 359 do
begin
x0:=a*cos(i/180*pi);
y0:=b*sin(i/180*pi);
xn:=cx+x0*cos(angl)-y0*sin(angl);
yn:=cy+x0*sin(angl)+y0*cos(angl);
putpixel(round(xn),round(yn),15);
end;
end;

procedure atom1;
begin
putimage(cx+round(a*cos((ugol+z1-1)*pi/180)),
cy+round(b*sin((ugol+z1-1)*pi/180)),p^,1);
putimage(cx+round(a*cos((ugol+z1)*pi/180)),
cy+round(b*sin((ugol+z1)*pi/180)),p^,0);
end;

procedure atom2;
begin
putimage(cx+round(b*sin((ugol+z2-1)*pi/180)),
cy+round(a*cos((ugol+z2-1)*pi/180)),p^,1);
putimage(cx+round(b*sin((ugol+z2)*pi/180)),
cy+round(a*cos((ugol+z2)*pi/180)),p^,0);
end;

procedure atom3;
var x0,y0,xn,yn:real; i:integer;
begin
x0:=a*cos((ugol+z3-1)/180*pi);
y0:=b*sin((ugol+z3-1)/180*pi);
xn:=cx+x0*cos(pi/4)-y0*sin(pi/4);
yn:=cy+x0*sin(pi/4)+y0*cos(pi/4);
putimage(round(xn),round(yn),p^,1);
x0:=a*cos((ugol+z3)/180*pi);
y0:=b*sin((ugol+z3)/180*pi);
xn:=cx+x0*cos(pi/4)-y0*sin(pi/4);
yn:=cy+x0*sin(pi/4)+y0*cos(pi/4);
putimage(round(xn),round(yn),p^,0);
end;

procedure atom4;
var x0,y0,xn,yn:real; i:integer;
begin
x0:=a*cos((ugol+z4-1)/180*pi);
y0:=b*sin((ugol+z4-1)/180*pi);
xn:=cx+x0*cos(-pi/4)-y0*sin(-pi/4);
yn:=cy+x0*sin(-pi/4)+y0*cos(-pi/4);
putimage(round(xn),round(yn),p^,1);
x0:=a*cos((ugol+z4)/180*pi);
y0:=b*sin((ugol+z4)/180*pi);
xn:=cx+x0*cos(-pi/4)-y0*sin(-pi/4);
yn:=cy+x0*sin(-pi/4)+y0*cos(-pi/4);
putimage(round(xn),round(yn),p^,0);
end;



begin
initialization;
setbkcolor(0);
clearviewport;
setcolor(kel);setfillstyle(1,kel);pieslice(re,re,0,360,re);
new(p);
getmem(p,imagesize(1,1,2*re+1,2*re+1));
getimage(0,0,2*re,2*re,p^);

clearviewport;
setcolor(kpr); setfillstyle(1,kpr);pieslice(cx,cy,0,360,rp);
ugol:=0;
while true do begin
ellipse(cx,cy,0,360,a,b);
ellipse(cx,cy,0,360,b,a);
ell(pi/4);
ell(-pi/4);
atom1;
atom2;
atom3;
atom4;
vihod;
inc(ugol);if ugol=360 then ugol:=0;
end;
end.



Сообщение отредактировано: sheka -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






А чего она у тебя на каждом шаге перерисовывает повернутый эллипс? Ресурсы только жрет этим. И замедляется...

1. Для того, чтоб отобразить движение предметов, не обязательно вызывать PutImage с NotmalPut, а потом - с XORput. Достаточно отобразить XORput-ом, потом чуть-чуть подождать, и опять отобразить тем же самым XORput-ом... Лишние вызовы PutImage убрал, сделал еще одну процедуру draw_atoms, если понадобится еще ускорить - запоминай положения атомов в массиве (у тебя если на то пошло всего 360 значений угла, и массив из 360*4(атома)*2(координаты X, Y)*4(размер одного вещественного числа) даже Турбо Паскаль вполне потянет, всего 11Кб)
uses crt,graph;
const
re=5;
rp=15;
a=40;
b=100;
cx=320;
cy=240;
kel=10;
kor=15;
kpr=13;
z1=0;
z2=110;
z3=50;
z4=230;
var
ugol:integer;
p:pointer;
xn,yn:integer;
cycle: boolean;
procedure init;
var gd,gm:integer;
begin gd:=detect; initgraph(gd,gm,''); end;

procedure vihod;
var c:char;
begin
if keypressed then begin
c:=readkey;
if c=#13 then begin
closegraph;
halt;
end;
end;
end;
procedure ell(angl:real);
var x0,y0,xn,yn:real; i:integer;
begin
setcolor(kor);
for i:=0 to 359 do
begin
x0:=a*cos(i/180*pi);
y0:=b*sin(i/180*pi);
xn:=cx+x0*cos(angl)-y0*sin(angl);
yn:=cy+x0*sin(angl)+y0*cos(angl);
putpixel(round(xn),round(yn),15);
end;
end;
procedure atom1;
begin
putimage(cx+round(a*cos((ugol+z1-1)*pi/180)),
cy+round(b*sin((ugol+z1-1)*pi/180)),p^,1);
end;
procedure atom2;
begin
putimage(cx+round(b*sin((ugol+z2-1)*pi/180)),
cy+round(a*cos((ugol+z2-1)*pi/180)),p^,1);
end;
procedure atom3;
var x0,y0,xn,yn:real; i:integer;
begin
x0:=a*cos((ugol+z3-1)/180*pi);
y0:=b*sin((ugol+z3-1)/180*pi);
xn:=cx+x0*cos(pi/4)-y0*sin(pi/4);
yn:=cy+x0*sin(pi/4)+y0*cos(pi/4);
putimage(round(xn),round(yn),p^,1);
end;
procedure atom4;
var x0,y0,xn,yn:real; i:integer;
begin
x0:=a*cos((ugol+z4-1)/180*pi);
y0:=b*sin((ugol+z4-1)/180*pi);
xn:=cx+x0*cos(-pi/4)-y0*sin(-pi/4);
yn:=cy+x0*sin(-pi/4)+y0*cos(-pi/4);
putimage(round(xn),round(yn),p^,1);
end;
procedure draw_atoms;
begin
atom1;
atom2;
atom3;
atom4;
end;

begin
writeln(normalput);
init;
setbkcolor(0);
clearviewport;
setcolor(kel);setfillstyle(1,kel);pieslice(re,re,0,360,re);
getmem(p,imagesize(1,1,2*re+1,2*re+1));
getimage(0,0,2*re,2*re,p^);
clearviewport;
setcolor(kpr); setfillstyle(1,kpr);pieslice(cx,cy,0,360,rp);
ugol:=0;

ellipse(cx,cy,0,360,a,b);
ellipse(cx,cy,0,360,b,a);
ell(pi/4);
ell(-pi/4);
draw_atoms;

while true do begin
draw_atoms;

vihod;
inc(ugol);if ugol=360 then ugol:=0;

draw_atoms;
delay(15); { <--- С этой задержкой можно поиграться }
end;
end.


2. У тебя некорректно выделялась память: New не работает с бестиповыми указателями, я убрал этот лишний вызов. Освободить память при выходе из программы не забудь, там тоже был неправильный вызов Dispose(p), но ты выделял память через GetMem, значит, надо освобождать через парную процедуру: FreeMem.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Я.
****

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

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


[quote name='volvo' date='4.06.2009 18:18' post='134499']

[quote]writeln(normalput);[/quote] что это такое?

[quote]1. Для того, чтоб отобразить движение предметов, не обязательно вызывать PutImage с NotmalPut, а потом - с XORput. Достаточно отобразить XORput-ом, потом чуть-чуть подождать, и опять отобразить тем же самым XORput-ом...
Код
  while true do begin
    draw_atoms;

    vihod;
    inc(ugol);if ugol=360 then ugol:=0;

    draw_atoms;
  end;
end.

[/quote]
почему это так? в какой момент происходит зарисовка прошлого рисунка?


[/quote]FreeMem.
[/quote]
память запоминать ту,которую брал при выделении в отдельную переменную?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 





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