DUzun's Web
Programare, proiecte personale, divertisment

uses crt,windos,dos;

label a;

var mx,my,cec,y,l,z,zs,h,m,s,hs:word;

    I,j:longint;

    hour,alarm,hc,mc,sc,hsc:string;

    key:char;

​

procedure cif(s:char;ex,ey:word);

var  c:array[1..5,1..5]of string;

begin

 for i:=0 to 4 do for j:=0 to 4 do c[i+1,j+1]:=' ';

if s in ['0'..'9'] then begin  case s of

 '0':begin c[2,1]:=#220;c[3,1]:=#220;c[1,2]:=#219;c[4,2]:=#219;

           c[1,3]:=#219;c[4,3]:=#219;

           c[1,4]:=#219;c[4,4]:=#219;c[2,5]:=#223;c[3,5]:=#223; end;

 '1':begin c[4,2]:=#219;c[4,3]:=#219;c[4,4]:=#219; end;

 '2':begin c[2,1]:=#220;c[3,1]:=#220;c[4,2]:=#219;

           c[2,3]:=#223;c[3,3]:=#223;c[1,3]:=#220;

           c[1,4]:=#219;c[2,5]:=#223;c[3,5]:=#223; end;

 '3':begin c[2,1]:=#220;c[3,1]:=#220;c[4,2]:=#219;

           c[2,3]:=#223;c[3,3]:=#223;c[4,3]:=#220;

           c[4,4]:=#219;c[2,5]:=#223;c[3,5]:=#223; end;

 '4':begin c[1,1]:=#220;c[4,1]:=#220;

           c[1,2]:=#219;c[4,2]:=#219;c[4,4]:=#219;

           c[2,3]:=#223;c[3,3]:=#223;c[4,3]:=#220; end;

 '5':begin c[2,1]:=#220;c[3,1]:=#220;c[1,2]:=#219;

           c[2,3]:=#223;c[3,3]:=#223;c[4,3]:=#220;

           c[4,4]:=#219;c[2,5]:=#223;c[3,5]:=#223; end;

 '6':begin c[2,1]:=#220;c[3,1]:=#220;c[1,2]:=#219;

           c[2,3]:=#223;c[3,3]:=#223;c[4,3]:=#220;

           c[4,4]:=#219;c[2,5]:=#223;c[3,5]:=#223;

           c[1,3]:=#220;c[1,4]:=#219; end;

 '7':begin c[2,1]:=#220;c[3,1]:=#220;c[1,2]:=#223;

           c[4,2]:=#219;c[4,3]:=#219;c[4,4]:=#219; end;

 '8':begin c[2,1]:=#220;c[3,1]:=#220;c[1,2]:=#219;c[4,2]:=#219;

           c[2,3]:=#223;c[3,3]:=#223;c[1,3]:=#220;c[4,3]:=#220;

           c[1,4]:=#219;c[4,4]:=#219;c[2,5]:=#223;c[3,5]:=#223; end;

 '9':begin c[2,1]:=#220;c[3,1]:=#220;c[1,2]:=#219;c[4,2]:=#219;

           c[2,3]:=#223;c[3,3]:=#223;c[4,3]:=#220;

           c[4,4]:=#219;c[2,5]:=#223;c[3,5]:=#223; end;

  end;

 for i:=0 to 4 do begin gotoxy(ex,i+ey);for j:=0 to 4 do write(c[j+1,i+1]);end;

                        end;

if s=':' then begin c[1,2]:=#220;c[1,4]:=c[1,2];

for i:=0 to 4 do begin gotoxy(ex,i+ey);for j:=0 to 1 do write(c[j+1,i+1]);end;

              end;

end;

 procedure sort(var w:word;var wc:string);

var s:string;

begin

str(w:0,s);

if length(s)=1 then s:='0'+s;wc:=s;

 end;

 procedure setalarm;

begin

gotoxy(2,my div 2-2);

write('Alarma: ');

for i:=1 to 2 do begin hc[i]:=readkey;write(hc[i]);end;write(':');

for i:=1 to 2 do begin mc[i]:=readkey;write(mc[i]);end;

alarm:=hc+':'+mc+':'+'00';

end;

procedure sun(s:word);

begin

case s of

1:begin sound(2000);delay(1000);nosound;delay(200);

        sound(1700);delay(1000);nosound;delay(300);

        sound(2200);delay(1000);nosound;end;

2:for i:=1 to 3 do begin

sound(1500);delay(6000);nosound;delay(2500);end;

end;

end;

 procedure suna;

label e;

begin

repeat

for i:=1 to 1000 do begin sound(1500+i);delay(100);end;

if keypressed then goto e;

for i:=1000 downto 1 do begin sound(1500+i);delay(100);end;

until keypressed;

e:nosound;

end;

{$M 8192,0,0}

​

begin

textmode(1);textattr:=$0f;clrscr;

mx:=lo(windmax);my:=hi(windmax);

     repeat

gotoxy(mx div 2-3,2);

getdate(y,l,z,zs);

write(z:2,'.',l:2,'.',y:4);

   repeat

gettime(h,m,s,hs);

sort(h,hc);sort(m,mc);sort(s,sc);

hour:=hc+':'+mc+':'+sc;

cif(hour[1],mx div 2-15,5);

cif(hour[2],wherex,5);

cif(hour[3],wherex,5);

cif(hour[4],wherex,5);

cif(hour[5],wherex,5);

cif(hour[6],wherex,5);

cif(hour[7],wherex,5);

cif(hour[8],wherex,5);

​

if m=0 then sun(2);

if hour=alarm then suna;

 repeat

cif(sc[1],(mx div 2)+9,5);cif(sc[2],wherex,5);

cec:=s;

while s=cec do begin

gettime(h,m,s,hs);

if keypressed then begin key:=readkey;

  case key of

 'a','A': setalarm;#27:halt; #59:sun(1); #60:sun(2);

  end;end;end;

sort(s,sc);

hour[7]:=sc[1];hour[8]:=sc[2];

 until (key=#27)or(s=0);

   until (key=#27)or(hour='00:00:00');

     until (key=#27);

​

end.

​