[salelltd]

bi havaifişek animasyonlu ekran koruyucusu..

uses crt,graph;
const max=40;maxnkt=20;dusmeivmesi=0.005;tolasilik=5;x1= 0;y1=0;x2=640;y2=440;
......dizi:array[1..15] of integer=(40,80,120,160,200,240,280,320,360,400,440 ,480,520,560,600);
type xy=record x,y:real;end;
.......havaifisek=record
........................k,h:xy;
........................p:boolean;
........................t1,tp,t:integer;
........................nn,r:byte;
........................nkt:array[1..maxnkt] of record k,h:xy;r:byte;end;
......................end;
var ht:array[1..max] of havaifisek;n,tt:byte;tick0,tick1,tickn,carpsay:lon gint;c:char;
procedure hfolustur(t,tp:integer;x,y,hx,hy:real;r:byte);
begin
..if n>=max then exit;n:=n+1;tickn:=tickn+1;
..ht[n].k.x:=x;ht[n].k.y:=y;
..ht[n].h.x:=hx;ht[n].h.y:=hy;
..ht[n].t:=t;ht[n].t1:=0;
..ht[n].p:=false;ht[n].nn:=0;
..ht[n].r:=r;ht[n].tp:=tp;
end;
function rndhx:real;
var k:shortint;
begin
..k:=2*random(2)-1;rndhx:=k*random(150)/200;
end;
function rndhy:real;
begin
..rndhy:=0.1+random(200)/300;
end;
procedure rhfolustur;
var u:byte;
begin
..u:=tickn mod 15+1;
..hfolustur(50+random(100),random(10)+random(15),d izi[u],y2-40,rndhx,rndhy,random(15)+1);
end;
procedure init;
procedure gr;
var gd,gm:integer;i:byte;
begin
..randomize;gd:=detect;initgraph(gd,gm,'');if graphresult<>0 then halt;
{..for i:=1 to 15 do outtextxy(dizi[i],445,chr(i+64));}
end;
var i:byte;
begin
..n:=0;tt:=0;tick0:=0;tick1:=0;tickn:=0;carpsay:=0 ;
..for i:=1 to 20 do
..begin
....hfolustur(300,20,95+i*10,400-i/5,0.15+(21-i)/125,0.8-i/125,15);
....hfolustur(300,20,505-i*10,400-i/5,-0.15-(21-i)/125,0.8-i/125,8);
..end;
..gr;
end;
procedure rline(x1,y1,x2,y2:real);
begin
..line(round(x1),round(y1),round(x2),round(y2));
end;
procedure rputpixel(x,y:real;r:byte);
begin
..putpixel(round(x),round(y),r);
end;
procedure patlat(i:byte);
var k,l:byte;m:shortint;
begin
..ht[i].nn:=maxnkt;
..for k:=1 to maxnkt do
..with ht[i].nkt[k] do
..begin
....k.x:=ht[i].k.x;k.y:=ht[i].k.y;
....m:=2*random(2)-1;h.x:=m*(1+random(10))/20;
....m:=2*random(2)-1;h.y:=m*(1+random(10))/20;
....r:=random(15)+1;
....setcolor(r);for l:=1 to 10 do rline(k.x+5*cos(l*pi/5),k.y-5*sin(l*pi/5),k.x+20*cos(l*pi/5),k.y-20*sin(l*pi/5));
....setcolor(0);for l:=1 to 10 do rline(k.x+5*cos(l*pi/5),k.y-5*sin(l*pi/5),k.x+20*cos(l*pi/5),k.y-20*sin(l*pi/5));
..end;
end;
procedure ayar;
var i,j:byte;
begin
..tt:=tt+1;
..if tt>5 then
..begin
....tt:=0;
....for i:=1 to n do for j:=i+1 to n do
....if (not ht[i].p) and (not ht[j].p) and (abs(ht[i].k.x-ht[j].k.x)<5) and (abs(ht[i].k.y-ht[j].k.y)<5) then
....begin
......ht[i].t1:=ht[i].t-1;ht[j].t1:=ht[j].t-1;carpsay:=carpsay+1;
....end;
....for i:=1 to n do
....begin
......ht[i].t1:=ht[i].t1+1;
......if (ht[i].t1>=ht[i].t) and (not ht[i].p) then
......begin
........ht[i].p:=true;patlat(i);
......end;
....end;
..end;
end;
procedure hfcizim(i:byte;b:boolean);
var u,s,c:real;j:byte;
begin
..u:=sqrt(sqr(ht[i].h.x)+sqr(ht[i].h.y));
..if u=0 then exit;
..c:=ht[i].h.x/sqrt(sqr(ht[i].h.x)+sqr(ht[i].h.y));
..s:=ht[i].h.y/sqrt(sqr(ht[i].h.x)+sqr(ht[i].h.y));
..if ht[i].p then
..begin
....for j:=1 to ht[i].nn do
....begin
......rputpixel(ht[i].nkt[j].k.x,ht[i].nkt[j].k.y,ht[i].nkt[j].r*ord(b));
....end;
..end else
..begin
....setcolor(ht[i].r*ord(b));
....rline(ht[i].k.x-1,ht[i].k.y,ht[i].k.x+5*c-1,ht[i].k.y-5*s);
....rline(ht[i].k.x,ht[i].k.y,ht[i].k.x+5*c,ht[i].k.y-5*s);
....rline(ht[i].k.x+1,ht[i].k.y,ht[i].k.x+5*c+1,ht[i].k.y-5*s);
....rline(ht[i].k.x-2*s,ht[i].k.y-2*c,ht[i].k.x+2*s,ht[i].k.y+2*c);
..end;
end;
procedure ciz(b:boolean);
var i:byte;
begin
..for i:=1 to n do hfcizim(i,b);
end;
procedure hareket;
var i,j,k,l,x:byte;
begin
..x:=n;
..for i:=1 to x do
..if ht[i].p then
..begin
....for j:=1 to ht[i].nn do
....begin
......ht[i].nkt[j].k.x:=ht[i].nkt[j].k.x+ht[i].nkt[j].h.x;
......ht[i].nkt[j].k.y:=ht[i].nkt[j].k.y-ht[i].nkt[j].h.y;
......ht[i].nkt[j].h.y:=ht[i].nkt[j].h.y-dusmeivmesi;
....end;
....k:=ht[i].nn;
....for j:=1 to k do
....if (ht[i].nkt[j].k.x>x2) or (ht[i].nkt[j].k.y>y2) or
.......(ht[i].nkt[j].k.x<x1) or (ht[i].nkt[j].k.y<y1) then
....begin
......for l:=j to k-1 do
......begin
........ht[i].nkt[l]:=ht[i].nkt[l+1];
......end;
......ht[i].nn:=ht[i].nn-1;
....end;
....if (k=0) or ((ht[i].tp<>-1) and (ht[i].t1-ht[i].t>ht[i].tp)) then
....begin
......for l:=i+1 to n do
......begin
........ht[l-1]:=ht[l];
......end;
......n:=n-1;
....end;
..end else
..begin
....ht[i].k.x:=ht[i].k.x+ht[i].h.x;
....ht[i].k.y:=ht[i].k.y-ht[i].h.y;
....ht[i].h.y:=ht[i].h.y-dusmeivmesi/8;
....if (ht[i].k.x>x2) or (ht[i].k.y>y2) or
.......(ht[i].k.x<x1) or (ht[i].k.y<y1) then
....begin
......for l:=i+1 to n do
......begin
........ht[l-1]:=ht[l];
......end;
......n:=n-1;
....end;
..end;
end;
procedure tickdeg;
begin
..tick0:=tick0+1;if tick0>500000 then begin tick0:=0;tick1:=tick1+1;end;
end;
procedure yazilar(b:boolean);
var s:string;
begin
..setcolor(ord(b)*15);
..str(tick0,s);
..outtextxy(0,y2+15,'Sm='+s);
..str(tick1,s);
..outtextxy(100,y2+15,'Sd='+s);
..str(tickn,s);
..outtextxy(200,y2+15,'Toplam='+s);
..str(n,s);
..outtextxy(300,y2+15,'Suanki='+s);
..str(carpsay,s);
..outtextxy(400,y2+15,'Carpisma='+s);
end;
begin
..init;
..repeat
....ciz(true);
....c:=#1;if keypressed then c:=readkey;
....case c of
......'a'..'o','A'..'O':hfolustur(100,20,dizi[ord(upcase(c))-64],y2-40,rndhx,rndhy,random(15)+1);
......#13:readkey;
....end;
....{yazilar(true);}delay(4);ciz(false);{yazilar(f alse);}
....if random(tolasilik)=0 then rhfolustur;
....ayar;hareket;tickdeg;
..until c=#27;
..closegraph;
end.