Previous Entry Share Next Entry
Необычные часы (FP)
Аватар
eolegv
Идея этих часов мне пришла ниоткуда, я подобного не видел, если видели киньте ссылку. Писал я ее не долго где-то часа два-три. Я думаю получилось весьма неплохо.
Вот текст этой программы

program tiktakps;
uses graph,crt,dos;
var a,b,c,d,dx,dy,e,j,x,y,i,r,r1,r2:integer;color:word;
    t1,t2,t3,t4,f1,f2,f3,f4:integer;s:string;
function col(cv:word):word;
begin
if cv=red then col:=blue else col:=red;
end;
procedure time;
begin
gettime(t1,t2,t3,t4);setfillstyle(1,black);bar(0,0,getmaxx,getmaxy);
setcolor(red);
if t1=0 then t1:=24;
for i:=1 to t1 do begin
color:=col(color);setcolor(color);
if i<=6 then for d:=1 to e do ellipse(dx,dy,90-i*15,105-i*15,r2-d,r2-d)
else for d:=1 to e do ellipse(dx,dy,450-i*15,465-i*15,r2-d,r2-d);
                 end;

if t2=0 then t2:=60;
for i:=1 to t2 do begin
color:=col(color);setcolor(color);
if i<=15 then for d:=1 to e do ellipse(dx,dy,90-i*6,96-i*6,r1-d,r1-d)
else for d:=1 to e do ellipse(dx,dy,450-i*6,456-i*6,r1-d,r1-d);
                 end;
gettime(t1,t2,t3,t4);
if t3<30 then c:=t3+3 else if t3<56 then c:=t3+4 else
repeat  gettime(t1,t2,t3,t4); until t3=0;
if t3=0 then t3:=60;
for i:=1 to c do begin
if i<=15 then for d:=1 to 2*e do ellipse(dx,dy,90-i*6,96-i*6,r-d,r-d)
else for d:=1 to 2*e do ellipse(dx,dy,450-i*6,456-i*6,r-d,r-d);
                 end;

end;
begin
a:=detect;
initgraph(a,b,'');writeln(getdrivername);
dx:=getmaxx div 2;dy:=getmaxy div 2;
r:=dx div 2;e:=dx div 15;color:=red;r1:=dx div 3;x:=0;
r2:=dx div 4;time;setfillstyle(1,black);settextstyle(0,0,2);
repeat
setviewport(0,0,getmaxx,getmaxy,clipoff);
gettime(t1,t2,t3,t4);sound(100);
repeat gettime(f1,f2,f3,f4) until (f3-t3=1)or(t3-f3=59);

if f3=0 then f3:=60;
if (f2=1)and(f3=60) then for i:=1 to e do
begin setcolor(black);
ellipse(dx,dy,0,360,r1-i,r1-i);setcolor(color);end;
if (f1=1)and(f2=0)and(f3=60) then for i:=1 to e do
begin setcolor(black);
ellipse(dx,dy,0,360,r2-i,r2-i);setcolor(color); end;
{if (f2=0)and(f3=60) then begin color:=col(color);setcolor(color);end; }

for j:=t3*6 to f3*6 do if j<=90 then
for i:=1 to 2*e   do begin ellipse(dx,dy,90-j,91-j,r-i,r-i);delay(0); end
else for c:=1 to 2*e do begin ellipse(dx,dy,450-j,451-j,r-c,r-c);delay(0); end;

if f2-t2<>0 then begin color:=col(color);setcolor(color);
if f2=0 then x:=60 else x:=f2;
if x<=15 then for y:=1 to e do ellipse(dx,dy,90-x*6,96-x*6,r1-y,r1-y)
else for y:=1 to e do ellipse(dx,dy,450-x*6,456-x*6,r1-y,r1-y);
                 end;
if f1-t1<>0 then begin color:=col(color);setcolor(color);
if f1=0 then x:=24 else x:=f1;
if x<=6 then for d:=1 to  e do ellipse(dx,dy,90-x*15,105-x*15,r2-d,r2-d)
else for d:=1 to e do ellipse(dx,dy,450-x*15,465-x*15,r2-d,r2-d);
                 end;
setviewport(dx-e,dy-e,dx+e,dy+e,clipon);
bar(0,0,2*e,2*e);str(f1,s);
outtextxy(2*(e div 3),e div 4,s);
str(f2,s);
outtextxy(2*(e div 3),3*e div 5+3,s);
str(f3,s);
outtextxy(2*(e div 3),3*e div 3+3,s);
until keypressed;nosound;
end.

Алгоритм построить нетрудно зная графические особенности паскаля. Часы рисуются с помощью неполных эллипсов.
tiktakps

Вот ссылки на эту программу
DepositFiles.com

ifolder.ru

Tags:

?

Log in