一、窗體

?

二、代碼

窗體代碼:

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.

?

總結

以上是生活随笔為你收集整理的用Delphi写扬声器音乐的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。