home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / ctenari / NoWork / PASCAL / G_TIME.PAS < prev    next >
Pascal/Delphi Source File  |  1997-12-30  |  3KB  |  141 lines
  1. {Public domain program od firmy NoWork Computer Systems}
  2.  
  3. program setric;
  4.  
  5. uses crt,graph,dos;
  6.  
  7. var a,b,c,gd,gm,mx,my,x,y:integer;
  8.     h, m, s, hund : Word;
  9.  
  10. var buttons, j, k, l, n : word;
  11.  
  12. label 1;
  13. function reset : word;
  14. var r : registers;
  15. begin
  16.   r.ax:=0;
  17.   intr($33,r);
  18.   reset:=r.ax;
  19. end;
  20.  
  21. procedure dispmouse;
  22. var r : registers;
  23. begin
  24.   r.ax:=1;
  25.   intr($33,r);
  26.   end;
  27.  
  28. procedure remvmouse;
  29. var r : registers;
  30. begin
  31. r.ax:=2;
  32. intr($33,r);
  33. end;
  34.  
  35. procedure query(var buttons, x, y : word);
  36. var r : registers;
  37. begin
  38. r.ax:=3;
  39. intr($33,r);
  40. buttons:=r.bx;
  41. x:=r.cx;
  42. y:=r.dx;
  43. end;
  44.  
  45.  
  46. function LeadingZero(w : Word) : String;
  47. var
  48.     s : String;
  49. begin
  50.     Str(w:0,s);
  51.     if Length(s) = 1 then
  52.     s := '0' + s;
  53.     LeadingZero := s;
  54. end;
  55.  
  56.  
  57. begin
  58.   gd:=detect;
  59.   initgraph(gd,gm,'c:\bp\bgi');
  60.   if GraphResult <> grOk then begin
  61.   sound(800);delay(200);nosound;
  62.   clrscr;
  63.   gotoxy(1,10);
  64.   writeln('ERROR: Graficky driver nebyl nalezen!!');
  65.   writeln('Nebyl nalezen soubor egavga.bgi.');
  66.   writeln('Skontrolujte jestli se nachazi v tomto adresari.');
  67.   halt(1);
  68.   end;
  69.   j:=j shr 3+1;
  70.   k:=k shr 3+1;
  71.  
  72.   repeat
  73.  
  74.  
  75.   Setcolor(red);
  76.   SetTextStyle(DefaultFont, HorizDir ,1 );
  77.   OutTextXY(5,450, '(c) NoWork Computer Systems 1996.');
  78.  
  79.   a:=random(450);
  80.   b:=random(410);
  81.   c:=random(16);
  82.  
  83.   setcolor(c);
  84.   SetTextStyle(UserCharSize, HorizDir ,5 );
  85.   GetTime(h,m,s,hund);
  86.   OutTextXY(a,b,LeadingZero(h));
  87.   OutTextXY(a+70,b-3 ,':');
  88.   OutTextXY(a+105,b,LeadingZero(m));
  89.   delay(30);
  90.  
  91.   setcolor(c);
  92.   SetTextStyle(UserCharSize, HorizDir ,5 );
  93.   GetTime(h,m,s,hund);
  94.   OutTextXY(a,b,LeadingZero(h));
  95.   OutTextXY(a+70,b-3 ,':');
  96.   OutTextXY(a+105,b,LeadingZero(m));
  97.   delay(30);
  98.  
  99.   setcolor(white);
  100.   SetTextStyle(UserCharSize, HorizDir ,5 );
  101.   GetTime(h,m,s,hund);
  102.   OutTextXY(a,b,LeadingZero(h));
  103.   OutTextXY(a+70,b-3 ,':');
  104.   OutTextXY(a+105,b,LeadingZero(m));
  105.   delay(50);
  106.  
  107.   setcolor(c);
  108.   SetTextStyle(UserCharSize, HorizDir ,5 );
  109.   GetTime(h,m,s,hund);
  110.   OutTextXY(a,b,LeadingZero(h));
  111.   OutTextXY(a+70,b-3 ,':');
  112.   OutTextXY(a+105,b,LeadingZero(m));
  113.   delay(30);
  114.  
  115.   setcolor(c);
  116.   SetTextStyle(UserCharSize, HorizDir ,5 );
  117.   GetTime(h,m,s,hund);
  118.   OutTextXY(a,b,LeadingZero(h));
  119.   OutTextXY(a+70,b-3 ,':');
  120.   OutTextXY(a+105,b,LeadingZero(m));
  121.   delay(30);
  122.  
  123.  
  124.   cleardevice;
  125.   Setcolor(red);
  126.   SetTextStyle(DefaultFont, HorizDir ,1 );
  127.   OutTextXY(5,450, '(c) NoWork Computer Systems 1996.');
  128.   delay(200);
  129.  
  130.      l:=l shr 3+1;
  131.      n:=n shr 3+1;
  132.  
  133.  
  134.      query(buttons, j, k);
  135.      if buttons and 1 = 1 then goto 1;
  136.      if buttons and 2 = 2 then goto 1;
  137.  
  138.      until keypressed;
  139.  
  140. 1:  closegraph;
  141. end.