Solved

Controlling the PC Speaker from Delphi 3

Posted on 1998-06-16
15
428 Views
Last Modified: 2010-04-04
In the good old days of dos 2.1. One could give a command "sound" and the PC-speaker would start making a noise untill it is stopped. Now things are different. We tell windows 95 we want a beep, it goes and determines the sound card and the type of sound the user configured and does the rest for you.

Unfortunately, the PC-speaker beep, ie, there is no sound card, is very soft and short. When one puts this in a heavy duty box, behind a panel, it cannot be heard. This is my problem.

HOW DO I SPECIFY THE FREQUENCY AND DURATION OF A PC-SPEAKER BEEP IN WIN95

I tried messagebeep, these all amounts to exactly the same sound. I tried two different Beep procedures, the one is without parameters and gives the same beep. The other beep procedure takes two parameters that the help says is used by Win NT, but ignored by Win95. Yes, it gives me the beep that is exactly the same as all the others.

There is one thing that starts approaching an answer, that is calling something like ten of these Beep's after the other, but it is not what one can discribe as a smooth solution. (And wastes time in an application that is already time criticcal.)

Any advice????
0
Comment
Question by:bra033098
15 Comments
 
LVL 5

Expert Comment

by:ronit051397
ID: 1353005
0
 
LVL 3

Expert Comment

by:Matvey
ID: 1353006
There's a driver for PC-Speaker in windows - similar to SB driver. -Don't ask me if it works, but I might find it. So if you think it can help - post your email.
0
 
LVL 8

Accepted Solution

by:
ZifNab earned 100 total points
ID: 1353007
Hi bra, a while ago a gave this answer. Does it suits for you?

    Found them some time ago on the net,

    Making PC Speaker Sound


    Below are the procedures Sound, NoSound, and Delay. They are called in
    the same way that Turbo Pascal's Sound, NoSound, and Delay procedures are
    called. For example, to produce a 600 Hz tone for 200 milliseconds, you
    would call the procedures as follows:

       Sound(600);
       Delay(200);
       NoSound;

    procedure TForm1.NoSound;
    begin
       Port[$61] := Port[$61] and $FC;
    end;


    procedure TForm1.Sound(Freq : Word);
    var
       B : Byte;
    begin
       if Freq > 18 then
          begin
             Freq := Word(1193181 div LongInt(Freq));

             B := Port[$61];

             if (B and 3) = 0 then
                begin
                   Port[$61] := B or 3;
                   Port[$43] := $B6;
                end;

             Port[$42] := Byte(Freq);
             Port[$42] := Byte(Freq shr 8);
          end;
    end;


    procedure TForm1.Delay(MSecs : Integer);
    var
       FirstTickCount : LongInt;
    begin
       FirstTickCount:=GetTickCount;
       repeat
          Application.ProcessMessages; {allowing access to other controls,
                                        etc.}
       until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
    end;

    Author: Thomas Foster

    Regards, Zif.





0
 
LVL 3

Expert Comment

by:Matvey
ID: 1353008
Cool Zif! ;-)

I'll check it out too
0
 
LVL 8

Expert Comment

by:ZifNab
ID: 1353009
My pleasure Matvey ;-)
0
 
LVL 3

Expert Comment

by:Matvey
ID: 1353010
Hmmm Zif,  "  Undeclared identifier 'Port'  "

I think something needs to be added to the USES...
0
 

Expert Comment

by:jannes
ID: 1353011
Try this unit.
I always use it in my educational programs...
In this way you can play all simple songs.

Met vriendelijke groeten,

Jannes

Email : stevens@okido.demon.nl
URL   : www.okido.demon.nl



unit Umusic;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  FileCtrl, IniFiles, Forms, Dialogs;

type
  TFMuziek = class(TForm)
    procedure FormActivate(Sender: TObject);
    procedure Sendnote;
    procedure Speel;
    procedure Getnum;
  private
    ModuleName, pchartemp  : array[0..255] of char;
    kk, dt, nm, st, pk, nr: LongInt;
    SearchRec: TSearchRec;
    ApplIni: string[60];
    Code, status, i: Integer;
    ini,strnm,nn,schijf: string[8];
    yy,mm,dag,yy2,mm2,dag2,uur,min,sec,msec:word;
  public
    music, dots, octave, voice:integer;
    data, reeks: string[128];
    newnote, newaccent:boolean;
    playlength, notelength, tempnum, pitch, tchars, tempo, lengte, charoff :integer;
    letter: string[1];
    numbers: string[10];
  end;

var
  FMusic: TFMusic;

implementation

{$R *.DFM}

procedure TFMusic.FormActivate(Sender: TObject);
begin
   reeks:='T240O2E8G4A8MLB8.>C16.MN<B8A4F#8MLD8.E16.MNF#8G4E8MLE8.D#16.MNE8F#4.<B4>';
   Speel;
end;

procedure TFMusic.Speel;
begin
    SetVoiceQueueSize(1,192);
    TChars:=Length(reeks);
    Tempo:=120;
    music := 0;
    Octave := 3;
    Lengte := 4;
    NewNote := False;
    NewAccent := True;
    CharOff := 1;
    repeat begin
      letter:=copy(reeks,charoff,1);
      if ((letter>='A') and (letter<='G')) or (letter='P')
      then begin
        sendnote;
        if letter='P' then pitch:=0;
        if letter='C' then pitch:=1;
        if letter='D' then pitch:=3;
        if letter='E' then pitch:=5;
        if letter='F' then pitch:=6;
        if letter='G' then pitch:=8;
        if letter='A' then pitch:=10;
        if letter='B' then pitch:=12;
        newnote:=true;
      end
      else if (letter>='1') and (letter<='9') then begin
        getnum;
        notelength:=tempnum;
      end
      else if letter='>' then begin
        sendnote;
        inc(octave);
      end
      else if letter='<' then begin
        sendnote;
        dec(octave);
      end
      else if (letter='+') or (letter='#') then inc(pitch)
      else if letter='-' then dec(pitch)
      else if letter='.' then inc(dots)
      else if letter='M' then begin
        sendnote;
        inc(charoff);
        letter:=copy(reeks,charoff,1);
        if letter='N' then music:=0;
        if letter='S' then music:=2;
        if letter='L' then music:=1;
        newaccent:=true;
      end
      else if letter='N' then begin
        sendnote;
        inc(charoff);
        getnum;
        pitch:=tempnum;
        newnote:=true;
        sendnote;
      end
      else if letter='O' then begin
        sendnote;
        inc(charoff);
        getnum;
        octave:=tempnum;
      end
      else if letter='T' then begin
        sendnote;
        inc(charoff);
        getnum;
        tempo:=tempnum;
        newaccent:=true;
      end
      else if letter='L' then begin
        sendnote;
        inc(charoff);
        getnum;
        lengte:=tempnum;
      end;
      inc(charoff);
    end until charoff>tchars;
    sendnote;
    startsound;
end;

procedure TFMusic.Sendnote;
begin
    If NewAccent Then SetVoiceAccent(1, Tempo, 1, music, 0);
    If NewNote Then begin
      If Pitch > 0 Then Pitch := (Pitch + (Octave * 12)) - 1;
      If NoteLength > 0 Then begin
          PlayLength := NoteLength;
          NoteLength := 0;
        end
      Else PlayLength := Lengte;
      SetVoiceNote (1, Pitch, PlayLength, Dots);
      Dots := 0
    End;
    NewNote := False;
    NewAccent := False;
end;

procedure TFMusic.getnum;
var
  TestChar: string[1];
begin
  numbers := '0123456789';
  TempNum := strtoint(copy(reeks, CharOff, 1));
  If CharOff < TChars Then begin
    TestChar := copy(reeks, CharOff + 1, 1);
    If (TestChar >= '0') and (testchar <= '9')  Then begin
      TempNum := TempNum * 10 + strtoint(TestChar);
      inc(CharOff);
    end
    Else exit;
  End;
  If CharOff < TChars Then begin
    TestChar := copy(reeks, CharOff + 1, 1);
    If (TestChar >= '0') and (testchar <= '9')  Then begin
      TempNum := TempNum * 10 + strtoint(TestChar);
      inc(CharOff);
    End;
  End;
end;

end.

0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 3

Expert Comment

by:Matvey
ID: 1353012
Hi Jannes, the same here as with ZifNabs code;

"  Undeclared identifier 'SetVoiceQueueSize'  "
"  Undeclared identifier 'startsound'  "
"  Undeclared identifier 'SetVoiceAccent'  "
"  Undeclared identifier 'SetVoiceNote'  "

I think you missed some unit or something...
0
 

Author Comment

by:bra033098
ID: 1353013
Matvey

I found the driver under
http://www.biozentrum.uni-wuerzburg.de/sounds/win95installation.html

Will try it out and let know if it works

bra
0
 
LVL 3

Expert Comment

by:Matvey
ID: 1353014
Great!

bra, have you tried any of the sugestions above? Did they work on your machine?
0
 
LVL 2

Expert Comment

by:kjteng
ID: 1353015
You can use the API in mmsystem to send a wav file to pc speaker.
For example
sndPlaySound( 'SystemDefault', snd_NoDefault)
sndPlaySound( 'file.wav', snd_NoDefault) etc

For more details please see:
http://www.experts-exchange.com/topics/comp/lang/delphi/Q.10056799

kjteng
0
 
LVL 3

Expert Comment

by:Matvey
ID: 1353016
I think the TMediaPlayer component will play it OK too - the windows sound recorder should play it well.
0
 
LVL 8

Expert Comment

by:ZifNab
ID: 1353017
Ok, what does this ?

procedure Sound(Freq : Word);
var
    B : Byte;
begin
    if Freq > 18 then
        begin
            Freq := Word(1193181 div LongInt(Freq));
            B := Byte(GetPort($61));

            if (B and 3) = 0 then
               begin
                   SetPort($61, Word(B or 3));
                   SetPort($43, $B6);
               end;

            SetPort($42, Freq);
            SetPort($42, Freq shr 8);
        end;
end;

procedure NoSound;
var
  Value: Word;
begin
    Value := GetPort($61) and $FC;
    SetPort($61, Value);
end;

procedure SetPort(address, Value:Word);
var
  bValue: byte;
begin
  bValue := trunc(Value and 255);
  asm
    mov dx, address
    mov al, bValue
    out dx, al
  end;
end;

function GetPort(address:word):word;
var
  bValue: byte;
begin
  asm
    mov dx, address
    in al, dx
    mov bValue, al
  end;
  GetPort := bValue;
end;

Zif.

0
 
LVL 3

Expert Comment

by:Matvey
ID: 1353018
Yeah!!! It works! Very cool Tom!
0
 
LVL 8

Expert Comment

by:ZifNab
ID: 1353019
Hello bra,

everything ok?

Zif.
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now