关于利用DELPHI调用扬声器的问题！！急！！！！(50分)

我制作了一个读取简谱的程序，是利用不同键的ASCII码调用相对应的频率。
但是不知道在DELPHI中如何让扬声器发出指定频率的声音。
哪位大虾救救我啊！！！
有其他途径实现读简谱的程序也行！！
急需啊！！！！

gz

没有问题的，不过在nt,2000,xp下不行，因为是用汇编调用中断实现的。
{---------------------------------_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 }

{--------------------------------BeepFor------------------------------------------
generates a Tone a MSecs long
----------------------------------------------------------------------------------}
procedure BeepFor(Tone : word;
MSecs : integer);
var
StartTime : LongInt;
begin


if Tone = REST
then

begin

StartTime:=GetTickCount;
while ( (GetTickCount - StartTime) < LongInt(MSecs) )do
Application.ProcessMessages;
Exit;
end;


case IsWin_NT of
True : Windows.Beep (Tone, MSecs);
False : begin

StartBeep(Tone);
StartTime:=GetTickCount;
while ( (GetTickCount - StartTime) < LongInt(MSecs) )do
Application.ProcessMessages;
StopBeep;
end;

end;


end;

{ BeepFor }

eg.简单例子，你可以试试其他频率
C = 131;

BeepFor (C_1,80);

NT,2000,XP下:
函数Beep(dwFreq, dwDuration)其中，dwfreq为声音频率，单位为赫兹，dwDuration为声音长度，单位为毫秒
Win9X下：
　　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;

汇编的我试过了
LOUHONG师兄的方法我试一下
可以就给分啊

gz

补充一点：
不好意思，请在引用时将“　”替换成" "，或者干脆都删除。
不小心弄成全角空格了 []

gz

我这里有对Beeper编程的VCL控件，在Win2000下使用无误，如果需要我Email给你！

方便的话发个给我吧!

doll-paul@263.net

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

do
Bleep (1109,100);可以达到你的要求



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.


这个单元其实在以前的delphi安装盘中就有

好,谢谢,成功了,我结分了