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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Цитата
writeln(normalput); что это такое?
Это можешь убрать. Я просто терпеть не могу, когда вместо именованных констант, специально введенных в разных библиотеках, используют ничего не значащие числа. Просто проверял, NormalPut - это 0 или 1...

Цитата
почему это так? в какой момент происходит зарисовка прошлого рисунка?
При первом вызове draw_atoms (перед циклом) эти самые атомы устанавливаются в начальную позицию. Потом, входим в цикл и начинаем: первый вызов draw_atoms внутри цикла затирает изображение атомов, поскольку если одно и то же изображение дважды наложить с маской XorPut, то останется только фон, самое изображение уничтожится (для примера, возьми число, скажем, 234, и сделай дважды ему побитовый XOR с любым другим числом. После второго XOR-а опять останется число 234. С изображениями - тот же принцип). Потом меняем угол, и второй вызов draw_atoms в цикле отображает атомы уже на новых позициях...

Цитата
память запоминать ту,которую брал при выделении в отдельную переменную?
Для того, чтоб правильно освободить память, надо знать, сколько ее было выделено. Вот так:
var buf_size: word; { <-- глобально }

buf_size := imagesize(1,1,2*re+1,2*re+1);
getmem(p, buf_size);
getimage(0,0,2*re,2*re,p^);

, а освобождать - так:
  freemem(p, buf_size);
 К началу страницы 
+ Ответить 

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

 





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