unit Unit2;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private procedure BeepFor(Tone : word; MSecs,PSecs : integer); { Private declarations } public function _GetPort(address:word):word; procedure _SetPort(address,Value:word); procedure StartBeep(Freq:word); procedure StopBeep; { Public declarations } end;var Form1: TForm1;implementation{$R *.DFM} function Tform1._GetPort(address:word):word; var bValue:byte; begin asm mov dx, address in al,dx mov bvalue, al end; result:=bvalue; end;procedure Tform1._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;
procedure Tform1.StartBeep(Freq : Word);//开始发音,Freq为频率 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 Tform1.StopBeep;//停止发音 var Value: Word; begin value := _GetPort($61) and $FC; _SetPort($61, Value); end;{$IFDEF WIN32} Var SysWinNT : Boolean; {$ENDIF}procedure TForm1.BeepFor(Tone : word; MSecs,Psecs : integer);//发出不同音调及不同时间长度的声音 var StartTime : LongInt; begin {$IFDEF WIN32} If SysWinNT Then Windows.Beep (Tone, MSecs) Else {$ENDIF} begin StartBeep(Tone); StartTime:=GetTickCount; while ( (GetTickCount - StartTime) < LongInt(MSecs) ) do Application.ProcessMessages; StopBeep; end; StartTime:=GetTickCount; while ( (GetTickCount - StartTime) < LongInt(PSecs) ) do Application.ProcessMessages; end;procedure TForm1.Button1Click(Sender: TObject); var Hour, Min, Sec, MSec:word; begin DecodeTime(Time, Hour, Min, Sec, MSec);//将时间解析出?时,分,秒,毫秒 Beepfor(3500,50,50); Beepfor(3500,50,50); Beepfor(3500,50,50); Beepfor(3500,50,50); Beepfor(3500,50,50); Beepfor(165,1000,10); //以下一段Beepfor语句奏响海关报时乐曲 Beepfor(131,1000,10); Beepfor(149,1000,10); Beepfor(98,1000,10); Beepfor(98,1000,10); Beepfor(149,1000,10); Beepfor(165,1000,10); Beepfor(131,1000,10); { if hour=0 then hour:=24; //到几点即敲几下钟(零点敲24下) while hour> 0 do begin Beepfor(131,1000); SlientFor(1000); hour :=hour-1 end; } 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.
http://www.csdn.net/expert/topic/951/951970.xml
这类的程序我曾经写过,在ASUS这类的硬件扬声器的主板没问题,但是在ECS这类的廉价集成的主板上就是从声卡发出来的。
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure BeepFor(Tone : word; MSecs,PSecs : integer);
{ Private declarations }
public
function _GetPort(address:word):word;
procedure _SetPort(address,Value:word);
procedure StartBeep(Freq:word);
procedure StopBeep;
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}
function Tform1._GetPort(address:word):word;
var bValue:byte;
begin
asm
mov dx, address
in al,dx
mov bvalue, al
end;
result:=bvalue;
end;procedure Tform1._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;
procedure Tform1.StartBeep(Freq : Word);//开始发音,Freq为频率
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 Tform1.StopBeep;//停止发音
var
Value: Word;
begin
value := _GetPort($61) and $FC;
_SetPort($61, Value);
end;{$IFDEF WIN32} Var SysWinNT : Boolean; {$ENDIF}procedure TForm1.BeepFor(Tone : word; MSecs,Psecs : integer);//发出不同音调及不同时间长度的声音
var
StartTime : LongInt;
begin
{$IFDEF WIN32} If SysWinNT Then Windows.Beep (Tone, MSecs) Else {$ENDIF}
begin
StartBeep(Tone);
StartTime:=GetTickCount;
while ( (GetTickCount - StartTime) < LongInt(MSecs) ) do Application.ProcessMessages;
StopBeep;
end;
StartTime:=GetTickCount;
while ( (GetTickCount - StartTime) < LongInt(PSecs) ) do
Application.ProcessMessages;
end;procedure TForm1.Button1Click(Sender: TObject);
var Hour, Min, Sec, MSec:word;
begin
DecodeTime(Time, Hour, Min, Sec, MSec);//将时间解析出?时,分,秒,毫秒
Beepfor(3500,50,50);
Beepfor(3500,50,50);
Beepfor(3500,50,50);
Beepfor(3500,50,50);
Beepfor(3500,50,50);
Beepfor(165,1000,10); //以下一段Beepfor语句奏响海关报时乐曲
Beepfor(131,1000,10);
Beepfor(149,1000,10);
Beepfor(98,1000,10);
Beepfor(98,1000,10);
Beepfor(149,1000,10);
Beepfor(165,1000,10);
Beepfor(131,1000,10);
{
if hour=0 then hour:=24; //到几点即敲几下钟(零点敲24下)
while hour> 0 do
begin
Beepfor(131,1000);
SlientFor(1000);
hour :=hour-1
end; }
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.