用Delphi写扬声器音乐

一、窗体

二、代码

窗体代码:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,BleepInt;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  Bleep(bOk);
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Bleep(bInterrupt);
end;

procedure TForm2.Button3Click(Sender: TObject);
var
  i:Integer;
begin
  for I := 100 to 150 do DoBleep(I*10,10);
  for I := 150 downto 100 do DoBleep(I*10,10); 
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
  Bleep(bError);
end;

procedure TForm2.Button5Click(Sender: TObject);
begin
  DoBleep(146,250);
  DoBleep(123,250);
  DoBleep(164,500);
  DoBleep(123,500);
  DoBleep(138,125);
  DoBleep(146,250);
  DoBleep(123,250);
  DoBleep(138,500);
  DoBleep(146,500);
  DoBleep(195,500);
  DoBleep(184,500);
  DoBleep(195,500);
  DoBleep(164,500);
  DoBleep(146,250);
  DoBleep(123,250);
  DoBleep(164,250);
  DoBleep(164,250);
  DoBleep(123,1000);
end;

procedure TForm2.Button6Click(Sender: TObject);
begin
  if Button6.Caption='噪音' then
  begin
    Button6.Caption:='停止';
    DoBleep(1000,-1);
  end
  else
  begin
    Button6.Caption:='噪音';
    ShutUp;
  end; 
end;

end.

其中BleepInt.pas(发声的核心函数)代码为：

unit BleepInt;

interface

type
  TBleepType=(bOk,bInterrupt,bError);

  procedure ShutUp;
  procedure DoBleep(Freq:Word;MSecs:Integer);
  procedure Bleep(BleepType:TBleepType);

implementation

uses
  Windows,Forms;

  procedure AsmShutUp;
  begin
    asm
      in AL,$61
      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;

  procedure HardBleep(Freq:Word;MSecs:Integer);
  var
    FirstTickCount:{$IFDEF WIN32}Dword{$ELSE}LongInt{$ENDIF};
  begin
    if (Freq>=20) and (Freq<=5000) then
    begin
      AsmBeep(Word(1193181 Div LongInt(Freq)));
      if MSecs>=0 then
      begin
        FirstTickCount :=GetTickCount;
        repeat
          {$IFDEF CONSOLE}if MSecs>1000 then
            Application.ProcessMessages; {$ENDIF}
        until ((GetTickCount-FirstTickCount)>LongInt(MSecs));
        AsmShutUp;
      end;
    end;
  end;

  procedure Bleep(BleepType:TBleepType);
  begin
    case BleepType of
      bOk:
        begin
          DoBleep(1047,100);
          DoBleep(1109,100);
          DoBleep(1175,100);
        end;
      bInterrupt:
        begin
          DoBleep(1047,100);
          DoBleep(1109,100);
          DoBleep(1175,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.