атом, проверьте Опции

[sheka]

визуализация атома.
подскажите пожалуйста:
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 - 4.06.2009 21:40

[volvo]

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);