Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 458
  • Last Modified:

Controlling the PC Speaker from Delphi 3

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
bra033098
Asked:
bra033098
1 Solution
 
MatveyCommented:
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
 
ZifNabCommented:
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
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
MatveyCommented:
Cool Zif! ;-)

I'll check it out too
0
 
ZifNabCommented:
My pleasure Matvey ;-)
0
 
MatveyCommented:
Hmmm Zif,  "  Undeclared identifier 'Port'  "

I think something needs to be added to the USES...
0
 
jannesCommented:
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
 
MatveyCommented:
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
 
bra033098Author Commented:
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
 
MatveyCommented:
Great!

bra, have you tried any of the sugestions above? Did they work on your machine?
0
 
kjtengCommented:
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
 
MatveyCommented:
I think the TMediaPlayer component will play it OK too - the windows sound recorder should play it well.
0
 
ZifNabCommented:
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
 
MatveyCommented:
Yeah!!! It works! Very cool Tom!
0
 
ZifNabCommented:
Hello bra,

everything ok?

Zif.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now