Solved

Controlling the PC Speaker from Delphi 3

Posted on 1998-06-16
15
429 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
Migrating to Microsoft Office 365 is becoming increasingly popular for organizations both large and small. If you have made the leap to Microsoft’s cloud platform, you know that you will need to create a corporate email signature for your Office 365…

895 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

15 Experts available now in Live!

Get 1:1 Help Now