Programalama > PASCAL

Etiketler: digital, saat

Ort. 0
Puan ver:
uses crt,graph,dos;
 label
  a;
 var
  p:pointer;
  t2:char;
  y1,y2,g1:string[4];
  t:string[10];
  kod,gd,gm:integer;
  s,s2,d,d2,sn,sn2,sl,sl2:word;
  yil,ay,gun,n:word;
  x,y,z,k,l,m:byte;
 procedure pen(x1,y1,x2,y2:word; s:string);
  begin
   setfillstyle(1,7);
   bar(x1,y1,x2,y2);
   setcolor(8);
   line(x1-1,y2+1,x2+1,y2+1);
   line(x1-2,y2+2,x2+2,y2+2);
   line(x2+1,y2+1,x2+1,y1-1);
   line(x2+2,y2+2,x2+2,y1-2);
   setcolor(15);
   line(x1-1,y1-1,x1-1,y2+1);
   line(x1-2,y1-2,x1-2,y2+2);
   line(x1-2,y1-2,x2+2,y1-2);
   line(x1-1,y1-1,x2+1,y1-1);
   setfillstyle(1,9);
   bar(x1+5,y1+5,x2-5,y1+19);
   setcolor(0);
   settextjustify(0,0);
   settextstyle(0,0,1);
   outtextxy(x1+10,y1+17,s);
 end;
 procedure yatay(a,b:word; e:byte);
  var
   koor:array[1..6] of pointtype;
  begin
   koor[1].x:=a;koor[1].y:=b;
   koor[2].x:=a+1;koor[2].y:=b-1;
   koor[3].x:=a+21;koor[3].y:=b-1;
   koor[4].x:=a+22;koor[4].y:=b;
   koor[5].x:=a+21;koor[5].y:=b+1;
   koor[6].x:=a+1;koor[6].y:=b+1;
    if e=0 then
     begin
      koor[5].y:=b+2; koor[6].y:=b+2;
     end;
   setcolor(e);
   setfillstyle(1,e);
   fillpoly(6,koor);
  end;
 procedure dikey(a,b:word; e:byte);
  var
   koor:array[1..6] of pointtype;
  begin
   koor[1].x:=a;koor[1].y:=b;
   koor[2].x:=a+1;koor[2].y:=b+1;
   koor[3].x:=a+1;koor[3].y:=b+21;
   koor[4].x:=a;koor[4].y:=b+22;
    if e=0 then
     begin
      koor[4].x:=a;koor[4].y:=b+23;
     end;
   koor[5].x:=a-1;koor[5].y:=b+21;
   koor[6].x:=a-1;koor[6].y:=b+1;
   setcolor(e);
   setfillstyle(1,e);
   fillpoly(6,koor);
  end;
 procedure ikinokta(a,b:word);
  begin
   setfillstyle(1,10);
   bar(a,b,a+3,b+3);
   bar(a,b+15,a+3,b+18);
  end;
 procedure sayi(a,b,q:word);
   procedure digi(k1,k2,k3,k4,k5,k6,k7:boolean);
    var
     koor:array[1..6] of pointtype;
    begin
     if k1=true then yatay(a+1,b-1,10) else yatay(a+1,b-1,0);
     if k2=true then dikey(a+25,b+1,10) else dikey(a+25,b+1,0);
     if k3=true then dikey(a+25,b+27,10) else dikey(a+25,b+27,0);
     if k4=true then yatay(a+1,b+51,10) else yatay(a+1,b+51,0);
     if k5=true then dikey(a-1,b+27,10) else dikey(a-1,b+27,0);
     if k6=true then dikey(a-1,b+1,10) else dikey(a-1,b+1,0);
     if k7=true then yatay(a+1,b+25,10) else yatay(a+1,b+25,0);
    end;
   begin
    case q of
     0 : digi(true,true,true,true,true,true,false);
     1 : digi(false,true,true,false,false,false,false);
     2 : digi(true,true,false,true,true,false,true);
     3 : digi(true,true,true,true,false,false,true);
     4 : digi(false,true,true,false,false,true,true);
     5 : digi(true,false,true,true,false,true,true);
     6 : digi(true,false,true,true,true,true,true);
     7 : digi(true,true,true,false,false,false,false);
     8 : digi(true,true,true,true,true,true,true);
     9 : digi(true,true,true,true,false,true,true);
    end;
   end;
 procedure alan2(x1,y1,x2,y2:word);
  begin
   setfillstyle(1,7);
   bar(x1,y1,x2,y2);
   setcolor(15);
   line(x1-1,y2+1,x2+1,y2+1);
   line(x1-2,y2+2,x2+2,y2+2);
   line(x2+1,y2+1,x2+1,y1-1);
   line(x2+2,y2+2,x2+2,y1-2);
   setcolor(8);
   line(x1-1,y1-1,x1-1,y2+1);
   line(x1-2,y1-2,x1-2,y2+2);
   line(x1-2,y1-2,x2+2,y1-2);
   line(x1-1,y1-1,x2+1,y1-1);
  end;
 procedure dugme1(x1,y1,x2,y2:word; s:string);
  begin
   setfillstyle(1,7);
   bar(x1,y1,x2,y2);
   setcolor(8);
   line(x1-1,y2+1,x2+1,y2+1);
   line(x1-2,y2+2,x2+2,y2+2);
   line(x2+1,y2+1,x2+1,y1-1);
   line(x2+2,y2+2,x2+2,y1-2);
   setcolor(15);
   line(x1-1,y1-1,x1-1,y2+1);
   line(x1-2,y1-2,x1-2,y2+2);
   line(x1-2,y1-2,x2+2,y1-2);
   line(x1-1,y1-1,x2+1,y1-1);
   setcolor(0);
   settextstyle(0,0,1);
   settextjustify(1,1);
   outtextxy((x2+x1) div 2,(y2+y1) div 2,s);
   getmem(p,imagesize(x1-2,y1-2,x2+2,y2+2));
   getimage(x1-2,y1-2,x2+2,y2+2,p^);
  end;
 procedure dugme2(x1,y1,x2,y2:word; s:string);
  begin
   setfillstyle(1,7);
   bar(x1,y1,x2,y2);
   setcolor(15);
   line(x1-1,y2+1,x2+1,y2+1);
   line(x1-2,y2+2,x2+2,y2+2);
   line(x2+1,y2+1,x2+1,y1-1);
   line(x2+2,y2+2,x2+2,y1-2);
   setcolor(8);
   line(x1-1,y1-1,x1-1,y2+1);
   line(x1-2,y1-2,x1-2,y2+2);
   line(x1-2,y1-2,x2+2,y1-2);
   line(x1-1,y1-1,x2+1,y1-1);
   setcolor(0);
   settextstyle(0,0,1);
   settextjustify(1,1);
   outtextxy((x2+x1) div 2+1,(y2+y1) div 2+1,s);
   delay(250);
   putimage(x1-2,y1-2,p^,0);
  end;
 begin
  detectgraph(gd,gm);
  initgraph(gd,gm,'C:\BP\BIN');
  if graphresult<>0 then halt;
a: pen(72,90,373,260,'        TALIP HAKAN OZTURK');
  getdate(yil,ay,gun,n);
  str(yil,y1);str(ay,y2);str(gun,g1);
  t:=g1+'/'+y2+'/'+y1;
  setcolor(1);
  settextstyle(2,0,6);
  settextjustify(1,1);
  outtextxy(225,210,t);
  dugme1(173,227,273,247,'AYAR');
  setfillstyle(1,0);
  bar(93,113,352,199);
  repeat
   gettime(s,d,sn,sl);
   x:=s div 10;y:=s-x*10;
   z:=d div 10; k:=d-z*10;
   l:=sn div 10; m:=sn-l*10;
   sayi(110,130,x); sayi(145,130,y);ikinokta(180,146);
   sayi(192,130,z); sayi(227,130,k);ikinokta(262,146);
   sayi(275,130,l); sayi(310,130,m);
   delay(50);
  until keypressed;
  t2:=readkey;
  if t2=#65 then
   begin
    dugme2(173,227,273,247,'AYAR');
    pen(130,110,370,240,'AYAR');
    alan2(160,170,200,200);
    alan2(230,170,270,200);
    alan2(300,170,340,200);
    setcolor(1);
    settextjustify(1,1);
    outtextxy(180,150,'saat');
    outtextxy(250,150,'dakika');
    outtextxy(320,150,'saniye');
    y1:='';y2:='';g1:='';
    for x:=1 to 2 do
     begin
      t2:=readkey;
      if t2 in [#48,#49,#50,#51,#52,#53,#54,#55,#56,#57] then
       begin
        y1:=y1+t2; outtextxy(170+8*x,185,t2);
       end
       else goto a;
     end;
     val(y1,s2,kod);
    for x:=1 to 2 do
     begin
      t2:=readkey;
      if t2 in [#48,#49,#50,#51,#52,#53,#54,#55,#56,#57] then
       begin
        y2:=y2+t2; outtextxy(240+8*x,185,t2);
       end
       else goto a;
     end;
     val(y2,d2,kod);
    for x:=1 to 2 do
     begin
      t2:=readkey;
      if t2 in [#48,#49,#50,#51,#52,#53,#54,#55,#56,#57] then
       begin
        g1:=g1+t2; outtextxy(310+8*x,185,t2);
       end
       else goto a;
     end;
     val(g1,sn2,kod);
     t2:=readkey;
     if t2=#13 then begin settime(s2,d2,sn2,0);  goto a; end;
   end;
  closegraph;
 end.


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.