home *** CD-ROM | disk | FTP | other *** search
/ Die ASC Mega 2 / ASC-Mega2-CD-ROM.iso / SPIELE / KAISER / MUSIK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-31  |  1.1 KB  |  64 lines
  1. unit Musik;
  2.  
  3.  
  4. interface
  5.  
  6. uses dos,crt;
  7.  
  8. type Toene = (c,cis,d,dis,e,f,fis,g,gis,a,b,h);
  9.  
  10. const Hoehe: array[Toene] of word =
  11.       (10465, 11087, 11747, 12445, 13185, 13969,
  12.        14800, 15680, 16613, 17600, 18647, 19755);
  13.  
  14.       Ganze = 150;
  15.  
  16. var OktaveFaktor: byte;
  17.  
  18.  
  19. procedure Play(Ton: Toene; Laenge, Pause: word);
  20. procedure Oktave(OktavNr: byte);
  21. procedure Warte(Laenge: longint);
  22.  
  23.  
  24. implementation
  25.  
  26.  
  27. function MomentZeit: longint;
  28. var h,m,s,hund: word;
  29. begin
  30.   GetTime(h, m, s, hund);
  31.   Momentzeit := h*360000+m*6000+s*100+hund
  32. end;
  33.  
  34.  
  35. procedure Warte(Laenge: longint);
  36.  
  37. var Start, Zeit1, Zeit2: longint;
  38.  
  39. begin
  40.   Start := Momentzeit;
  41.   Zeit1 := Start + Laenge;
  42.   repeat
  43.     Zeit2 := Momentzeit;
  44.   until (Zeit2 > Zeit1) or (Zeit2 < Start)
  45. end;
  46.  
  47. procedure Play(Ton: Toene; Laenge, Pause: word);
  48. begin
  49.   sound(Hoehe[Ton] div OktaveFaktor);
  50.   warte(Ganze div Laenge);
  51.   nosound;
  52.   if Pause > 0 then
  53.     warte(Ganze div Pause)
  54. end;
  55.  
  56.  
  57. procedure Oktave(OktavNr: byte);
  58. begin
  59.   OktaveFaktor := 256 shr OktavNr
  60. end;
  61.  
  62. begin
  63.   Oktave(2);
  64. end.