让主板发声的命令我知道,Windows.Beep.
像我们在装声卡的时候,那时声卡还没有,装完之后,系统提示要重启电脑,就有一声响,那时声就是报警声,现在我想
调成那声音,但是我用Windows.Beep调了好久,都调不出那样的声音,大家帮一下啊.
像我们在装声卡的时候,那时声卡还没有,装完之后,系统提示要重启电脑,就有一声响,那时声就是报警声,现在我想
调成那声音,但是我用Windows.Beep调了好久,都调不出那样的声音,大家帮一下啊.
License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This unit is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this unit; if not, write to the
Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}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: LongInt); { 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};{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Assembler Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }procedure AsmShutUp; {$IFDEF WIN32}pascal; {$ENDIF}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;{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Low Level Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }procedure HardBleep(Freq: Word; MSecs: LongInt);
const
HiValue = {$IFDEF WIN32}High(DWord){$ELSE}High(LongInt){$ENDIF};
var
iCurrTickCount, iFirstTickCount: {$IFDEF WIN32}DWord{$ELSE}LongInt{$ENDIF};
iElapTime: LongInt;
begin
if (Freq >= 20) and (Freq <= 5000) then begin
AsmBeep(Word(1193181 div LongInt(Freq)));
if MSecs >= 0 then begin
iFirstTickCount := GetTickCount;
repeat
{$IFNDEF CONSOLE}
if MSecs > 1000 then Application.ProcessMessages;
{$ENDIF}
iCurrTickCount := GetTickCount;
{ Has GetTickCount wrapped to 0 ? }
if iCurrTickCount < iFirstTickCount then iElapTime := HiValue - iFirstTickCount + iCurrTickCount
else iElapTime := iCurrTickCount - iFirstTickCount;
until iElapTime >= MSecs;
AsmShutUp;
end;
end;
end;{ This is the old 'succumbs to Murphy's Law version of HardBleep }
{ I'll delete it later - it's here just in case Murphy's Law hits the new one }
{ Why have I used (* *) style comments to hide it? }(* 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>-1 Then Begin
FirstTickCount:=GetTickCount;
Repeat
{$IFNDEF CONSOLE} If MSecs>1000 Then Application.ProcessMessages; {$ENDIF}
Until ((GetTickCount-FirstTickCount)>{$IFDEF WIN32} DWord {$ELSE} LongInt {$ENDIF}(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: LongInt);
begin
if MSecs < -1 then MSecs := 0;
{$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.
示例：
DoBleep(500,100);
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
Button2: TButton;
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
procedure BeepFor(Tone: word; MSecs: integer);
procedure SlientFor(MSecs: integer); { Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
function _GetPort(address: word): word;
procedure _SetPort(address, Value: Word);
procedure StartBeep(Freq: Word);
procedure StopBeep;implementation{$R *.dfm}function _GetPort(address: word): word; //获取端口
var
bValue: byte;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end;
Result := bValue;
end;procedure _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 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 StopBeep; //停止发音
var
Value: Word;
begin
value := _GetPort($61) and $FC;
_SetPort($61, Value);
end;procedure TForm1.BeepFor(Tone: word; MSecs: integer); //发出不同音调及不同时间长度的声音
var
StartTime: LongInt;
begin
StartBeep(Tone);
StartTime := GetTickCount;
while ((GetTickCount - StartTime) < LongInt(MSecs)) do Application.ProcessMessages;
StopBeep;
end;procedure TForm1.SlientFor(MSecs: integer); //静音若干时间
var
StartTime: LongInt;
begin
StartTime := GetTickCount;
while ((GetTickCount - StartTime) < LongInt(MSecs)) do
Application.ProcessMessages;
end;procedure TForm1.Timer1Timer(Sender: TObject);
var Hour, Min, Sec, MSec: word;
begin
if Frac(time * 24) * 3600 < 0.1 then //将捕捉整点时间的精度控制在0.1秒内
begin
Timer1.Enabled := false;
DecodeTime(Time, Hour, Min, Sec, MSec); //将时间解析出小时,分,秒,毫秒
Beepfor(165, 1000); //以下一段Beepfor语句奏响海关报时乐曲
Beepfor(131, 1000);
Beepfor(149, 1000);
Beepfor(98, 1000);
SlientFor(1000);
Beepfor(98, 1000);
Beepfor(149, 1000);
Beepfor(165, 1000);
Beepfor(131, 1000);
SlientFor(1000);
if hour = 0 then hour := 24; //到几点即敲几下钟(零点敲24下)
while hour > 0 do
begin
Beepfor(131, 1000);
SlientFor(1000);
hour := hour - 1
end;
Timer1.Enabled := true;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Beepfor(165, 1000); //以下一段Beepfor语句奏响海关报时乐曲
Beepfor(131, 1000);
Beepfor(149, 1000);
Beepfor(98, 1000);
SlientFor(1000);
Beepfor(98, 1000);
Beepfor(149, 1000);
Beepfor(165, 1000);
Beepfor(131, 1000);
SlientFor(1000);end;procedure TForm1.Button2Click(Sender: TObject);
begin
Beepfor(000, 1000); //以下一段Beepfor语句奏响海关报时乐曲
Beepfor(262, 1000);
Beepfor(296, 1000);
Beepfor(330, 1000);
Beepfor(349, 1000);
Beepfor(392, 1000);
Beepfor(440, 1000);
Beepfor(494, 1000);
SlientFor(1000);
Beepfor(98, 1000);
Beepfor(149, 1000);
Beepfor(165, 1000);
Beepfor(131, 1000);
SlientFor(1000);
end;end.