Quelle  Utilities.~pas   Sprache: unbekannt

unit Utilities;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, ClipBrd,
  ToolWin, ActnList, ImgList, MMSystem, OleServer, ShellApi,
  SpeechLib_TLB;

type
   TSound    = (HappyBirthDay, SongofJoy, Ding, DingDong,
                Kennenlerntag, MartinasGeburtstag, Hochzeitstag,
                BeethovensGeburtstag, BachsGeburtstag, Internationale,
                Bourree, RadioHamburg, Alarm, Sailing, DieGedankensindfrei);

var
    SpVoice: TspVoice;
    Speaker:integer;
    SOTokens: ISpeechObjectTokens;

  procedure EnumVoices(VoiceNo:integer;Leise:String;Combo:TComboBox);
  procedure Speak(Rate:integer;T:String);
  function  SoundCheck: boolean;
  Procedure PCSounder(i : TSound);


implementation

//----------------------------------------------------------------
//
//     produce speech from clipboard
//
//----------------------------------------------------------------
procedure Speak(rate:integer;T:String);
begin
  if Speaker > 0 then begin
    SpVoice.Voice := SOTokens.Item(Speaker-1);
    SpVoice.Rate:=rate;
    SpVoice.Speak(T, SVSFDefault)
  end
end;

//----------------------------------------------------------------
//
//     test for sound card
//
//----------------------------------------------------------------
function SoundCheck: boolean;
begin
   if WaveOutGetNumDevs > 0 then
     SoundCheck := true
   else
     SoundCheck := false
end;

//----------------------------------------------------------------
//
//     get voices from machine
//
//----------------------------------------------------------------
procedure EnumVoices(VoiceNo:integer;Leise:String;Combo:TComboBox);
var
  i, NoVoices: Integer;
  SOToken: ISpeechObjectToken;
  dwVersion : double;
begin
  if not SoundCheck then begin
    Speaker := 0;
    Combo.Items.AddObject(Leise, nil);
    Combo.ItemIndex:=0;
    exit;
  end;
  dwVersion := GetVersion();
  if (dwVersion >= $80000000) then  // no Windows XP
  begin
    Speaker := 0;
    Combo.Items.AddObject(Leise, nil);
    Combo.ItemIndex:=0;
    exit;
  end;
  SpVoice := TSpVoice.Create(nil);
  //enter silent mode
  Combo.Items.Clear;
  Combo.Items.AddObject(Leise, nil);
  Combo.ItemIndex:=0;
  //Ensure all events fire
  SpVoice.EventInterests := SVEAllEvents;
  SOTokens := SpVoice.GetVoices('', '');
  NoVoices := SOTokens.Count - 1;
  for I := 0 to NoVoices do
  begin
    //For each voice, store the descriptor in the TStrings list
    SOToken := SOTokens.Item(I);
    Combo.Items.AddObject(SOToken.GetDescription(0), TObject(SOToken));
    //Increment the descriptor reference count to ensure it doesn't get destroyed
    SOToken._AddRef;
  end;
  if NoVoices >= 0 then
    Combo.ItemIndex := 0; //Select 1st voice
  // set options
  if (NoVoices >=1) and
  (VoiceNo <= Combo.Items.Count) then begin
      Speaker := VoiceNo;
      Combo.ItemIndex := Speaker;
  end;
end;


//----------------------------------------------------------------
//
//     produce pc speaker beeps
//     with predefined songs
//
//----------------------------------------------------------------
procedure PCSpeakerBeep(Frequency, Duration: Integer);
  begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
     Windows.Beep(Frequency, Duration)
  else
   asm
   MOV ECX, Frequency
   JCXZ @@2
   MOV EAX, 1193181
   CDQ
   IDIV ECX
   MOV ECX, EAX
   IN AL, ($61)
   TEST AL, $03
   JNZ @@1
   OR AL, $03
   OUT ($61), AL
   MOV AL, $B6
   OUT ($43), AL
   @@1: MOV AL, CL
   OUT ($42), AL
   MOV AL, CH
   OUT ($42), AL
   PUSH Duration
   CALL Windows.Sleep
   @@2: IN AL, ($61)
   AND AL, $FC
   OUT ($61), AL
end;
end;

//------------------------------------------------------------------
//
//              Procedure PCSounder
//           for to sound from PC beeper loauspeaker
//
//------------------------------------------------------------------
Procedure PCSounder(i : TSound);
const
   c000  = 32.70;
   c00   = 65.41;
   c0    = 130.81;
   g0    = 196.0;
   a0    = 220.0;
   h0    = 246.94;
   c     = 261.63;
   cis   = 277.18;
   d     = 293.67;
   es    = 311.13;
   e     = 329.63;
   f     = 349.23;
   fis   = 369.99;
   g     = 392.0;
   ass   = 415.31;
   gis   = ass;
   a     = 440.0;
   b     = 466.16;
   h     = 493.88;
   c1    = 261.63;
   c2    = 523.25;
   c3    = 1046.51;
   c4    = 2093.02;
   c5    = 4186.03;

   full  = 512;
   half  = 256;
   Quart = 128;
   eigth = 64;
var
   Hz       : real;
   j        : integer;
   BaseTone : integer;
   Offset   : integer;
   Tempo    : real;
procedure Tone(f : real;d : integer);
var
 frequency : longint;
 dure:variant;
begin
 frequency := trunc(f);
 dure :=  d * Tempo;
 PCSpeakerBeep(frequency,dure);
 sleep(dure);
 //SetVoiceSound(1,frequency,trunc(d*Tempo))
end; {Tone}
procedure Pause(d : integer;Tempo : real);
begin
  Sleep(d);
  // SetVoiceSound(1,frequency,trunc(d*Tempo))
end; {Pause}

begin
  case i of
    HappyBirthDay :
        begin
           Tempo := 1;
           Tone(g,quart+eigth);
           Tone(g,eigth);
           Tone(a,half);
           Tone(g,half);
           Tone(c2,half);
           Tone(h,full);
           Tone(g,quart+eigth);
           Tone(g,eigth);
           Tone(a,half);
           Tone(g,half);
           Tone(2*d,half);
           Tone(c2,full);
           Tone(g,quart+eigth);
           Tone(g,eigth);
           Tone(g*2,half);
           Tone(e*2,half);
           Tone(c2,quart);
           Tone(c2,quart);
           Tone(c2,half);
           Tone(a,half);
           Tone(f*2,quart+eigth);
           Tone(f*2,eigth);
           Tone(e*2,half);
           Tone(c2,half);
           Tone(d*2,half);
           Tone(c2,full);
        end;
    SongofJoy :
        begin
           Tempo := 4.0 / 3.0;
           Tone(e,quart);
           Tone(e,quart);
           Tone(f,quart);
           Tone(g,quart);
           Tone(g,quart);
           Tone(f,quart);
           Tone(e,quart);
           Tone(d,quart);
           Tone(c,quart);
           Tone(c,quart);
           Tone(d,quart);
           Tone(e,quart);
           Tone(e,quart+eigth);
           Tone(d,eigth);
           Tone(d,half+quart);

           Tone(e,quart);
           Tone(e,quart);
           Tone(f,quart);
           Tone(g,quart);
           Tone(g,quart);
           Tone(f,quart);
           Tone(e,quart);
           Tone(d,quart);
           Tone(c,quart);
           Tone(c,quart);
           Tone(d,quart);
           Tone(e,quart);
           Tone(d,quart+eigth);
           Tone(c,eigth);
           Tone(c,half+quart);

           Tone(d,quart);
           Tone(d,quart);
           Tone(e,quart);
           Tone(c,quart);
           Tone(d,quart);
           Tone(e,eigth);
           Tone(f,eigth);
           Tone(e,quart);
           Tone(c,quart);
           Tone(d,quart);
           Tone(e,eigth);
           Tone(f,eigth);
           Tone(e,quart);
           Tone(d,quart);
           Tone(c,quart);
           Tone(d,quart);
           Tone(g/2,half);

           Tone(e,half);
           Tone(f,quart);
           Tone(g,quart);
           Tone(g,quart);
           Tone(f,quart);
           Tone(e,quart);
           Tone(d,quart);
           Tone(c,quart);
           Tone(c,quart);
           Tone(d,quart);
           Tone(e,quart);
           Tone(d,quart+eigth);
           Tone(c,eigth);
           Tone(c,half+quart);
        end;
    Bourree :
        begin
           Tempo := 1.0;
           Tone(a,quart);
           Tone(h,quart);
           Tone(2*c,quart+eigth);
           Tone(h,eigth);
           Tone(a,quart+eigth);
           Tone(gis,quart+eigth);
           Tone(a,eigth);
           Tone(h,quart+eigth);
           Tone(e,quart+eigth);
           Tone(fis,eigth);
           Tone(gis,quart+eigth);
           Tone(a,quart+eigth);
           Pause(quart,Tempo);

           Tone(g,quart);
           Tone(f,quart);
           Tone(e,quart+eigth);
           Tone(d,eigth);
           Tone(c,quart+eigth);
           Tone(h/2,quart+eigth);
           Tone(c,eigth);
           Tone(d,quart+eigth);
           Tone(e,quart+eigth);
           Tone(d,quart);
           Tone(c,quart);
           Tone(h/2,quart);
           Tone(a/2,half);
           Pause(quart,Tempo)
        end;
   RadioHamburg :
       begin
          Tempo := 1.0;
          Tone(f,quart);
          Tone(d,quart);
          Tone(g,quart);
          Tone(e,half);
          Tone(c,quart);
          Pause(half,Tempo);
       end;
   Internationale :
       begin
          Tempo := 1.0;
          // Völker höret die Signale
          Tone(e,quart+eigth);
          Tone(d,eigth);
          Tone(c,half);
          Tone(g0,half);
          Tone(g0,half);
          Tone(g0,half);
          Tone(a0,half);
          Tone(a0,half);
          Pause(quart,Tempo);
          //  auf zum letzten gefecht
          Tone(d,quart+eigth);
          Tone(c,eigth);
          Tone(h0,full);
          Tone(a0,half);
          Tone(g0,half);
          Tone(e,full);
          Pause(half,Tempo);
          // die Internationale
          Tone(e,quart);
          Tone(g,half+quart);
          Tone(g,quart);
          Tone(f,half);
          Tone(e,half);
          Tone(d,half);
          Tone(e,half);
          Tone(f,half);
          Pause(half,Tempo);
          // erkämpft das Menschenrecht
          Tone(f,quart);
          Tone(e,half+quart);
          Tone(c,quart);
          Tone(d,half+quart);
          Tone(h0,quart);
          Tone(c,full);
          Pause(half,Tempo);
       end;
   Sailing :
       begin
          Tempo := 4.0 / 3.0;
          Tone(e,quart);
          Tone(g,quart);
          Tone(a,half);
          Tone(a,quart);
          Pause(quart,Tempo);

          Tone(h,quart);
          Tone(d*2,quart);
          Tone(e*2,half);
          Tone(e*2,quart);
          Pause(quart,Tempo);

          Tone(e*2,quart+eigth);
          Tone(d*2,eigth);
          Tone(d*2,half);
          Tone(c*2,quart+eigth);
          Pause(eigth,Tempo);

          Tone(c*2,quart+eigth);
          Tone(h,eigth);
          Tone(h,half);
          Pause(eigth,Tempo);

          Tone(c*2,quart);
          Tone(h,quart);
          Tone(a,half);
          Tone(a,quart+eigth);
          Pause(eigth,Tempo);

          Tone(h,quart);
          Tone(a,quart);
          Tone(g,half);
          Tone(g,quart+eigth);
          Pause(eigth,Tempo);

          Tone(e,quart);
          Tone(e,quart);
          Tone(h,half);
          Tone(a,quart+eigth);
          Pause(eigth,Tempo);

          Tone(a,quart);
          Tone(g,quart);
          Tone(g,half);
          Pause(quart,Tempo)
        end;
   Ding :
        begin
          Tempo := 1.5;
          Tone(e,eigth);
          Tone(e,eigth)
        end;
   DingDong :
        begin
          Tempo := 1.5;
          Tone(e,eigth);
          Tone(e,eigth);
          Tone(c,eigth);
          Tone(c,eigth)
        end;
   DieGedankensindfrei :
        begin
          tempo := 1.5;
          Tone(e,eigth);
          Tone(e,eigth);
          Tone(a,quart);
          Tone(a,quart);
          Tone(cis,eigth);
          Tone(a,eigth);
          Tone(e,half);
          Tone(e,quart);
          Tone(d,Quart);
          Tone(h,Quart);
          Tone(e,Quart);
          Tone(c,Quart);
          Tone(a/2,Quart);
          Pause(half,Tempo);
          Tone(a,Quart);
          Tone(gis,Quart);
          Tone(h,Quart+eigth);
          Tone(gis,eigth);
          Tone(a,Quart);
          Tone(cis,Quart);
          Tone(a,Quart);
          Tone(gis,Quart);
          Tone(h,Quart+eigth);
          Tone(gis,eigth);
          Tone(a,Quart);
          Tone(cis,Quart);
          Tone(a,Quart);
          Tone(fis,Quart);
          Tone(fis,Quart);
          Tone(a,eigth);
          Tone(fis,eigth);
          Tone(e,half);
          Tone(e,eigth);
          Tone(cis,eigth);
          Tone(cis,eigth);
          Tone(h,eigth);
          Tone(a,Quart);
          Tone(gis,Quart);
          Tone(a,half);
      end;
   Alarm :
        begin
          BaseTone := 880;
          Offset   := 440;
          for j := 1 to 200 do
          begin
             Hz := BaseTone + sin(j*2*3.1415/300)*Offset;
             PCSpeakerBeep(Trunc(Hz),10+j div 4);
             //SetVoiceSound(1,trunc(Hz),10+j div 4)
          end;
        end;
   end;
end; {Sounder}

end.