win2000下如何使PC的扬声器发声?(100分)

  • 主题发起人 主题发起人 zw84611
  • 开始时间 开始时间
Z

zw84611

Unregistered / Unconfirmed
GUEST, unregistred user!
在WIN98下可以使用汇编使PC的扬声器发声,但在WIN2000或NT下这段汇编不允许运行,请
问,DELPHI中有什么办法可以使PC的扬声器在WIN2000下发声?
 
messagebeep(0);
 
messagebeep(0)声音太小!而且无法控制时间和频率。我需要声音大一些,能够引起人
的注意。
 
你可以用BOOL Beep(
DWORD dwFreq, // sound frequency, in hertz
DWORD dwDuration // sound duration, in milliseconds
);这个API函数来实现。
通过设置循环来改变声音的频率和持续时间,即可用PC喇叭发出音乐!
 
看我的

{---------------------------------_GetPort--------------------------------------}
function _GetPort(address:word):word;
var
bValue: byte;
begin

asm
mov dx, address
in al, dx
mov bValue, al
end;

Result := bValue;
end;

{ _GetPort }


{----------------------------------_SetPort--------------------------------------}
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;

{ _SetPort }


{----------------------------------StartBeep--------------------------------------}
procedure StartBeep(Freq : Word);
var
B: Byte;
begin

if (Freq >= LOW_FREQ) and (Freq <= HIGH_FREQ)
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;

{ StartBeep }



{------------------------------StopBeep----------------------------------------}
procedure StopBeep;
var
Value: Word;
begin

Value := _GetPort($61) and $FC;
_SetPort($61, Value);
end;

{ StopBeep }


用法:
StartBeep(Tone);
// Tone为频率
StartTime:=GetTickCount;
while ( (GetTickCount - StartTime) < LongInt(MSecs) )do
//MSecs为响声长度(毫秒)
Application.ProcessMessages;
StopBeep;
 
除了汇编,就是用VC写个dll来调用

使用以下单元
//调用方法: Bleep(bOK);
// Bleep(bOK1);
// Bleep(bOK2);
// Bleep(bOK3);
以及其它


Unit BleepInt;
{ Version 4.2 }

{ Andy Preston - Apollo Developments, Swindon U.K. andy@apollod.freeserve.co.uk

HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE!

How to make your Delphi programs bleep like FRACTINT! See Demo1.pas/Demo1.dfm or Bleepint.htm for details
}

Interface

Type
TBleepType = (bOK, bInterrupt, bError,bSuccess,bOK2,bOK3, bHello);

Procedure ShutUp;
{ Added to help counter the effects ofdo
Bleep (Freq, -1).
If you are producing a tone, &amp;
you want to stop withoutdo
ing another Bleep, call this procedure }

Proceduredo
Bleep (Freq : Word;
MSecs : Integer);
{ Duration of -1 means bleep until the next bleep sent, or ShutUp is called }

Procedure Bleep (BleepType : TBleepType);

Implementation

Uses
{$IFDEF WIN32} Windows, {$else
} WinProcs, {$ENDIF}
{$IFNDEF CONSOLE} Forms;
{$ENDIF} { Michl Ladislav suggested removing the Forms unit from 32-bit Console Apps, saving 130K }


{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Assembler Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }

Procedure AsmShutUp;
{$IFDEF WIN32} Pascal;
{$ENDIF}
begin

Asm
In AL, $61 { Stop Bleeping }
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 : Integer);
Var
{ Changed FirstTickCount from LongInt to DWord to counter P.Satyanarayana's Delphi 4 Warning - see below }
FirstTickCount : {$IFDEF WIN32} DWord {$else
} LongInt {$ENDIF};
begin

{ Michl Ladislav pointed out that having a delay when the bleep freq is out of range is a waste of 'stuff' so I've added
another begin
END }
If (Freq>=20) And (Freq<=5000) then
begin

AsmBeep (Word (1193181 Div LongInt(Freq)));
If MSecs>=0 then
begin

{ P.Satyanarayana Get's a warning under Delphi 4 here 'Comparing signed and unsigned types - widened both operands'
This should be cleared up by the fact that FirstTickCount is now a DWord under Win32 }
FirstTickCount:=GetTickCount;
{ Michl Ladislav suggested changing the old WHILEdo
to a REPEAT UNTIL so as to fit his modifications in easyer }
Repeat
{ Michl Ladislav suggested removing the Forms unit from 32-bit Console Apps, saving 130K }
{$IFNDEF CONSOLE} If MSecs>1000 then
Application.ProcessMessages;
{$ENDIF}
Until ((GetTickCount-FirstTickCount)>LongInt(MSecs));
AsmShutUp;
end;

end;

end;


{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- Procedures for you to use -- --- -- --- -- --- -- --- -- --- -- --- }

Procedure Bleep (BleepType : TBleepType);
var
i: integer;
begin

Case BleepType of
bOK: begin

do
Bleep (1047,100);
do
Bleep (1109,100);
do
Bleep (1175,100);
end;

bInterrupt: begin

do
Bleep (2093,100);
do
Bleep (1976,100);
do
Bleep (1857,100);
end;

bError: begin

do
Bleep (200,200);
do
Bleep (300,200);
do
Bleep (200,200);
end;

bSuccess: begin

do
Bleep (1047,50);
do
Bleep (1109,50);
do
Bleep (1175,50);
end;

bOK2: begin

do
Bleep (1175,100);
do
Bleep (1109,100);
do
Bleep (1047,100);
end;

bOK3: begin

do
Bleep (1109,100);
do
Bleep (1175,100);
do
Bleep (1047,100);
end;

bHello: begin

do
Bleep (609,100);
do
Bleep (775,100);
do
Bleep (647,100);
end;


end;

end;


{$IFDEF WIN32} Var SysWinNT : Boolean;
{$ENDIF}

Proceduredo
Bleep (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.
 
感谢各位!
to WindFantasy:
BOOL Beep(
DWORD dwFreq, // sound frequency, in hertz
DWORD dwDuration // sound duration, in milliseconds
);
在VC++下使用可以实现在Win2000下使扬声器发声,但在Delphi中的Beep是不带参数的,
Delphi中的Beep就是MessageBeep(0);(见SysUtils)。

to cemi:
您的方法我试过,Win98下可以,但在Win2000下运行会显示"private instruction",
无法正常运行。

to htw:
用VC写一个dll,Delphi调用当然可以,但我想知道有没有在Delphi中的方法。

请大家注意,我问的前提是在“Win2000或NT下”用Delphi使扬声器发生,而不是在Win9x
下。Win2000或NT下有些汇编指令是不能使用的。大家可以先试一下。:)
 
帮忙答一下我的问题好不好:
问题:关于控件包使用及子窗体问题!!!!!! ( 积分:100, 回复:1, 阅读:16 )
 
赫赫,笑死人了,在NT和2000下面要使PC喇叭发声,居然要直接操作端口?
只要调用Windows.Beep(频率,延迟)就可以了。
 
真不好意思,多谢!多谢!
 
后退
顶部