怎样使系统扬声器发出不同的报警声？在线等待

Question

在Delphi中怎样使系统扬声器发出不同的报警声？我是一位新手请详细指教

Answer 1

其实messagebox里的MB_ICONERROR,MB_ICONEXCLAMATION等常量设置就可发出不同声音

Answer 2

以下是一个组件，用法很简单，我就不说了！
它可以在Windows 9x下发声！unit PCSpk;{* Program : PCSpk.Pas
   Purpose : TPCSpeaker Component   Author        Version  Last Changed  Comments
   ------        -------  ------------  --------
   Song Weng Sam 1.01     Aug. 28, 96   Initial Release (Version set to 1.01
                                        to match the 16bit version which is
                                        currently 1.01 too.)
*}interfaceuses
   Classes, WinProcs, Forms;type
   TPCSpeaker = class(TComponent)
   private
      { Private declarations }
      procedure NoSound;
      procedure Sound(Freq: Word);
      procedure SetPort(address, value: Word);
      function GetPort(address: Word): Word;
   protected
      { Protected declarations }
   public
      { Public declarations }
      procedure Delay(MSecs: Integer);
      procedure Play(Freq: Word; MSecs: Integer);
      procedure Stop;
   published
      { Published declarations }
   end;procedure Register;implementationprocedure TPCSpeaker.NoSound;
var
   wValue: Word;
begin
   wValue := GetPort($61);
   wValue := wValue and $FC;
   SetPort($61, wValue);
end;procedure TPCSpeaker.Sound(Freq: Word);
var
   B: Word;
begin
   if Freq > 18 then begin
      Freq := Word(1193181 div LongInt(Freq));      B := GetPort($61);      if (B and 3) = 0 then begin
         SetPort($61, B or 3);
         SetPort($43, $B6);
      end;      SetPort($42, Freq);
      SetPort($42, (Freq SHR 8));
   end;
end;procedure TPCSpeaker.Delay(MSecs: Integer);
var
   FirstTickCount : LongInt;
begin
   FirstTickCount:=GetTickCount;
   repeat
      Application.ProcessMessages; {allowing access to other controls, etc.}
   until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;procedure TPCSpeaker.Play(Freq: Word; MSecs: Integer);
begin
   Sound(Freq);
   Delay(MSecs);
   NoSound;
end;procedure TPCSpeaker.Stop;
begin
   NoSound;
end;procedure TPCSpeaker.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 TPCSpeaker.GetPort(address: Word): Word;
var
   bValue: Byte;
begin
   asm
      mov DX, address
      in  AL, DX
      mov bValue, AL
   end;
   result := bValue;
end;procedure Register;
begin
   RegisterComponents('Sun', [TPCSpeaker]);
end;end.在Windows NT等系统下请使用Windows.Beep();函数，是系统函数，可以直接调用

Answer 3

由于 9X 和 2000 中让喇叭发声效果不一样，所以我总是去判断
它是 9X 或是 2000 ，于是我就这样判断：
If Win32Platform = VER_PLATFORM_WIN32_NT Then
   Windows.Beep(500{Hz},60{Sec})
Else Beep;
至于 XP ，我还没用过，不知道。 

Answer 4

const int scale = 1193180 ;
    WORD freqTemp = (WORD)(scale/freq) ;    if ( Form1->blNT )//NT and 2000
    {
        Beep ( freqTemp, delay ) ;
        return ;
    }    asm     //发声  //9x
    {
        in al,61h;
        or al,3;
        out 61h,al;
        mov al,0xb6;
        out 43h,al;
        mov ax,freqTemp;
        out 42h,al;
        mov al,ah;
        out 42h,al;
    }    Sleep ( delay ) ;    asm     //关闭声音
    {
        in al,0x61;
        and al,0xfc;
        out 0x61,al;
    }

Answer 5

Unit BleepInt; { Version 4.2 }{ Andy Preston - Apollo Developments, Swindon U.K. [email protected]  HACKERS OF THE WORLD UNITE!    HACKERS OF THE WORLD UNITE!    HACKERS OF THE WORLD UNITE!    HACKERS OF THE WORLD UNITE!   How to make your Delphi programs bleep like FRACTINT!  See Demo1.pas/Demo1.dfm or Bleepint.htm for details 
}InterfaceType
  TBleepType = (bOK, bInterrupt, bError);Procedure ShutUp; { Added to help counter the effects of DoBleep (Freq, -1).
                    If you are producing a tone, & you want to stop without doing another Bleep, call this procedure }Procedure DoBleep (Freq : Word; MSecs : Integer); { Duration of -1 means bleep until the next bleep sent, or ShutUp is called }Procedure Bleep (BleepType : TBleepType);ImplementationUses
  {$IFDEF WIN32} Windows, {$ELSE} WinProcs, {$ENDIF}
  {$IFNDEF CONSOLE} Forms; {$ENDIF} { Michl Ladislav suggested removing the Forms unit from 32-bit Console Apps, saving 130K }
{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Assembler Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }Procedure AsmShutUp; {$IFDEF WIN32} Pascal; {$ENDIF}
Begin
  Asm
    In AL, $61  { Stop Bleeping }
    And AL, $FC
    Out $61, AL
  End;
End;Procedure AsmBeep (Freq : Word); {$IFDEF WIN32} Pascal; {$ENDIF}
Label
  Skip;
Begin
  Asm
        Push BX
        In AL, $61
        Mov BL, AL
        And AL, 3
        Jne Skip
        Mov AL, BL
        Or AL, 3
        Out $61, AL
        Mov AL, $B6
        Out $43, AL
  Skip: Mov AX, Freq
        Out $42, AL
        Mov AL, AH
        Out $42, AL
        Pop BX
  End;
End;{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Low Level Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }Procedure HardBleep (Freq : Word; MSecs : Integer);
Var
  { Changed FirstTickCount from LongInt to DWord to counter P.Satyanarayana's Delphi 4 Warning - see below }
  FirstTickCount : {$IFDEF WIN32} DWord {$ELSE} LongInt {$ENDIF};
Begin
  { Michl Ladislav pointed out that having a delay when the bleep freq is out of range is a waste of 'stuff' so I've added
    another BEGIN END }
  If (Freq>=20) And (Freq<=5000) Then Begin
    AsmBeep (Word (1193181 Div LongInt(Freq)));
    If MSecs>=0 Then Begin
      { P.Satyanarayana Get's a warning under Delphi 4 here 'Comparing signed and unsigned types - widened both operands'
        This should be cleared up by the fact that FirstTickCount is now a DWord under Win32 }
      FirstTickCount:=GetTickCount;
      { Michl Ladislav suggested changing the old WHILE DO to a REPEAT UNTIL so as to fit his modifications in easyer }
      Repeat
        { Michl Ladislav suggested removing the Forms unit from 32-bit Console Apps, saving 130K }
        {$IFNDEF CONSOLE} If MSecs>1000 Then Application.ProcessMessages; {$ENDIF}
      Until ((GetTickCount-FirstTickCount)>LongInt(MSecs));
      AsmShutUp;
    End;
  End;
End;{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- Procedures for you to use -- --- -- --- -- --- -- --- -- --- -- --- }Procedure Bleep (BleepType : TBleepType);
Begin
  Case BleepType of
    bOK: Begin
      DoBleep (1047,100);
      DoBleep (1109,100);
      DoBleep (1175,100);
    End;
    bInterrupt: Begin
      DoBleep (2093,100);
      DoBleep (1976,100);
      DoBleep (1857,100);
    End;
    bError: DoBleep (40,500);
  End;
End;{$IFDEF WIN32} Var SysWinNT : Boolean; {$ENDIF}Procedure DoBleep (Freq : Word; MSecs : Integer);
Begin
  {$IFDEF WIN32} If SysWinNT Then Windows.Beep (Freq, MSecs) Else {$ENDIF}
  HardBleep (Freq, MSecs);
End;Procedure ShutUp;
Begin
  {$IFDEF WIN32} If SysWinNT Then Windows.Beep (1, 0) Else {$ENDIF}
  AsmShutUp;
End;{$IFDEF WIN32}  Procedure InitSysType;
  Var
    VersionInfo : TOSVersionInfo;
  Begin
    VersionInfo.dwOSVersionInfoSize:=SizeOf (VersionInfo);
    GetVersionEx (VersionInfo);
    SysWinNt:=VersionInfo.dwPlatformID=VER_PLATFORM_WIN32_NT;
  End;  Initialization
    InitSysType;{$ENDIF}End.

Answer 6

wlw88(飞扬）我刚试，可以，但不是扬声器，是音箱。