Beep()和MessageBeep();均通过声卡发声,如何让PC自带的喇叭发声?

解决方案 »

  1.   

    Beep() 是通过声卡么 ? 倒没有注意...
    Study
      

  2.   

    procedure Sound(Freq:Integer);
    var
        p:Integer;
    begin
        P:=1190000 div Freq;
        asm
             mov al,10110110B
             out 43h,al
             mov ax,P
             out 42h,al
             mov al,ah
             out 42,al
             in  al,61h
             mov ah,al
             or  al,03h
             out 61h,al
        end;
    end;
      

  3.   

    大富翁上的:
    :sunstone 时间:00-9-3 7:51:42 ID:325632  
    送你一个控件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.
     
     
    --------------------------------------------------------------------------------
    来自:浦欣 时间:00-9-4 1:29:47 ID:326342  
        sunstone的这个控件实际上和原来提问中的那段程序一样,但我还想要得是一些声音例子,就象
    “电子日记本”的“备忘录”中,有一些做好的声音可选!
        或者给出每个调所对应的频率来自:terry_lzs 时间:00-10-24 10:48:33 ID:374463  
    用汇编吧
    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls;type
      Tpcspeaker = class(TForm)
        Button1: TButton;
        Button2: TButton;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
      private
      procedure NoSound;
          procedure Sound(Freq: Word);
          procedure SetPort(address, value: Word);
          function GetPort(address: Word): Word;
        { Private declarations }
      public
      procedure Delay(MSecs: Integer);
          procedure Play(Freq: Word; MSecs: Integer);
        { Public declarations }
      end;var
      pcspeaker: Tpcspeaker;implementation{$R *.DFM}
    procedure 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);
          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.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;
      

  4.   


    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 Tpcspeaker.Button1Click(Sender: TObject);
    begin
    play(1800,100);//由这两个参数控制音调
    end;procedure Tpcspeaker.Button2Click(Sender: TObject);
    begin
    NoSound;
    end;end.来自:whb_li 时间:00-10-26 0:17:21 ID:376428  
    to terry_lzs:  打扰,我用你的代码调试了一下,发现
         asm
          mov DX, address
          in  AL, DX     /////这一行出错
          mov bValue, AL
       end;
    --------------------------------------------------------------------------------
    来自:terry_lzs 时间:00-10-26 8:27:07 ID:376539  
    to whb_li:我在我的电脑上用delphi 4和delphi 5都试过了,没有问题。
    如果你是把网页上的直接拷贝到unit上请注意删除一些不可见的字符。
    我以前有遇到这种问题的。
     
    --------------------------------------------------------------------------------
    来自:pino 时间:00-11-21 9:49:23 ID:399668  
    在nt下不能直接对端口操作,可以用api messagebeep
    而在win9x下就不能用api,可以在代码里面根据系统选择实现方式
    来自:xjktthq 时间:00-11-21 9:57:09 ID:399678  
    for i:=9 to 20 do
            windows.beep(i*130,20);
     
    --------------------------------------------------------------------------------
    来自:cat.yy 时间:01-1-31 23:25:07 ID:445935  
    呀呀 鞋都跑丢了  不知能否帮上忙
    (用API 如果有声卡 好像有点麻烦)
    *------------------------------- DLL 的 dpr 代码 --------------
    library SpeakSound;//uses
    //  SysUtils,
    //  Classes,procedure pcSound(dFreq:Double;wLong:Word);export;
    var
      wFreq:word;
    begin
      wFreq := round(1192576/dFreq);
      asm
        push ax
        push bx
        push cx
        push dx
        push di
        mov  al,0B6H
        out  43H,al
        mov  dx,12H
        mov  ax,wFreq
        out  42H,al
        mov  al,ah
        out  42H,al
        in   al,61H
        mov  ah,al
        or   al,3
        out  61H,al
    @wait1:
        mov  cx,wLong
    @delay:
        dec  cx
        jnz  @delay
        dec  bx
        jnz  @wait1
        mov  al,0B6H
        out  43H,al
        mov  al,ah
        out  61H,al
        pop  di
        pop  dx
        pop  cx
        pop  bx
        pop  ax
      end;
    end;exports
      pcSound;begin
    end.
    * ------------------------------ 调用的例子 ------------------
    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls;type
      TForm1 = class(TForm)
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
    var
      DLLName:string;
      Buffer:array[0..127] of Char;
      LIB:THandle;
      pcSound:procedure(dFreq:Double;wLong:Word);
    begin
      DLLName := 'SpeakSound.dll';
      StrPCopy(Buffer,DLLName);
      Lib := LoadLibrary(Buffer);
      if not(Lib=0) then
        try
          pcSound := GetProcAddress(Lib,'pcSound');
          pcsound(440.0,1000);
        Finally
          FreeLibrary(Lib);
        end
      else
        Showmessage('failed');
    end;end.
    {
    261.7   c
    293.7   d
    329.6   e
    349.2   f
    392.0   g
    440.0   a
    493.9   b
    }
    --------------------------------------------------------------------------------
    来自:悲酥清风 时间:01-2-6 16:23:18 ID:450522  
    AHM2000 Freeware 中有个PcSpeaker控件,带源码的,源码在AHM2000的主叶上有!
    来自:Iknow 时间:01-2-6 17:36:31 ID:450601  
    ^_^ 连cdefgab都出来了. 音乐功底不错嘛.c=1, d=2, ... ^_^其实如果是在Windows下, 为什么不尝试用系统中的声卡设备(如果有的话)?DOS下如果用Borland Pascal的话, 可以用sound(frequency);delay(duration);nosound;
    组合来发声, 效果还可以的.
      

  5.   

    procedure sound(mhz : integer);
    {mhz = the frequency of the pc speaker}
     var
       count    : word;
       oldport,
       newport  : byte;  begin
        count := 1193280 div mhz;
        asm
          mov al,$b6
          out $43,al
          mov ax,count
          out $42,al
          mov al,ah
          out $42,al
          mov al,3
          out $61,al
        end;
      end;procedure nosound;
    {turn off the pc speaker}
      begin
        asm
          mov al,0
          out $61,al
        end;
      end;
    拷的,试试
      

  6.   

    有那么复杂吗?
    给你一个const
        MHZ:Array[8] of Integer=(523,587,659,698,784,880,988,1047);
    var
        I:Integer;for I:=Low(MHZ) to High(MHZ) do
        windows.beep(MHZ[I],500);
      

  7.   

    Beep()应该就是你要找的。
    我的电脑没声卡更无音箱之类,
    但Beep()一下,挺响的!
      

  8.   

    没有声卡的话beep,messagebeep就可以了,这个beep是delphi封装的
    有声卡的话只能用windows.beep了,这个beep是API
      

  9.   

    多谢各位参与,祝大家新年快乐!!
    经验证:
    在Delphi中直接调用Beep()时不行,使用Windows.Beep()使用Api函数
    就可以了。
    楼上lanxingw(Qao Kei)的方法最适合(win2000系统下),因此得分。
    谢谢