[Back to SOUND SWAG index]  [Back to Main SWAG index]  [Original]

{
> Does anyone have a "musical scale" of all the values With the Sound
> Function? A friend is writing a "happy birthday" Program and wants to
> get a list of all the notes without actually testing them (G)

{ Here's a handy Unit that takes a lot of work out of playing music. }
{ I think it originally came from this echo.                         }

Unit Music;
Interface
Uses Crt;
Const
   e_note = 15;       { Eighth Note      }
   q_note = 30;       { Quarter Note     }
   h_note = 60;       { Half Note        }
   dh_note = 90;      { Dotted Half Note }
   w_note = 120;      { Whole Note       }
   R = 0;             { Rest             }
   C = 1;             { C                }
   Cs = 2;            { C Sharp          }
   Db = 2;            { D Flat           }
   D = 3;             { D                }
   Ds = 4;            { D Sharp          }
   Eb = 4;            { E Flat           }
   E = 5;             { Etc...           }
   F = 6;
   Fs = 7;
   Gb = 7;
   G = 8;
   Gs = 9;
   Ab = 9;
   A = 10;
   As = 11;
   Bb = 11;
   B = 12;

Procedure PlayTone(Octave : Byte; Note : Byte; Duration : Word);
Procedure ToneOn(Octave   : Byte; Note     : Byte);

Implementation

Var
   Oct_Val  : Array [0..8] Of Real;
   Freq_Val : Array [C..B] Of Real;

Procedure Set_Frequencies;
Var N : Byte;
begin
   Freq_Val[1] := 1;
   For N := 2 To 12 Do
      Freq_Val[N] := Freq_Val[N-1] * 1.0594630944;
   Oct_Val[0] := 32.70319566;
   For N := 1 To 8 Do
      Oct_Val[N] := Oct_Val[N-1] * 2;
end;

Procedure PlayTone(Octave : Byte;
                   Note : Byte;
                   Duration : Word);
begin
   If Note = R Then
      NoSound
   Else
      Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));
   Delay(Duration*8);
   NoSound;
end;

Procedure ToneOn(Octave : Byte;
                 Note   : Byte);
begin
   If Note = R Then NoSound
   Else Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));

end;

begin
Set_Frequencies;
NoSound;
end.


{
Someone else: Here they are:

Const
    C     =  2093;
    C#    =  2217;
    D     =  2349;
    D#    =  2489;
    E     =  2637;
    F     =  2794;
    F#    =  2960;
    G     =  3136;
    G#    =  3322;
    A     =  3520;
    A#    =  3729;
    H     =  3951;

The next C is 2*2093, the C below is 2093 div 2 etc. pp.
}

{

Here's an octive:
  C = 262;
  CSHARP = 277;
  D = 294;
  DSHARP = 311;
  E = 330;
  F = 349;
  FSHARP = 370;
  G = 392;
  GSHARP = 415;
  A = 440;
  ASHARP = 466;
  B = 494;
  CC = 523;
}

[Back to SOUND SWAG index]  [Back to Main SWAG index]  [Original]