请教让PC嗽叭发声的程序，并举出一些声音例子(80分)

beep;
messagebeep();

送你一个控件

unit PCSpk;

{* Program : PCSpk.Pas
Purpose : TPCSpeaker Component

Author Version Last Changed Comments
------ ------- ------------ --------
Song Weng Sam 1.01 Aug. 28, 96 Initial Release (Version set to 1.01
to match the 16bit version which is
currently 1.01 too.)
*}

interface

uses
Classes, WinProcs, Forms;

type
TPCSpeaker = class(TComponent)
private
{ Private declarations }
procedure NoSound;
procedure Sound(Freq: Word);
procedure SetPort(address, value: Word);
function GetPort(address: Word): Word;
protected
{ Protected declarations }
public
{ Public declarations }
procedure Delay(MSecs: Integer);
procedure Play(Freq: Word;
MSecs: Integer);
procedure Stop;
published
{ Published declarations }
end;


procedure Register;

implementation

procedure TPCSpeaker.NoSound;
var
wValue: Word;
begin

wValue := GetPort($61);
wValue := wValue and $FC;
SetPort($61, wValue);
end;


procedure TPCSpeaker.Sound(Freq: Word);
var
B: Word;
begin

if Freq > 18 then
begin

Freq := Word(1193181 div LongInt(Freq));

B := GetPort($61);

if (B and 3) = 0 then
begin

SetPort($61, B or 3);
SetPort($43, $B6);
end;


SetPort($42, Freq);
SetPort($42, (Freq SHR 8));
end;

end;


procedure TPCSpeaker.Delay(MSecs: Integer);
var
FirstTickCount : LongInt;
begin

FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages;
{allowing access to other controls, etc.}
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;


procedure TPCSpeaker.Play(Freq: Word;
MSecs: Integer);
begin

Sound(Freq);
Delay(MSecs);
NoSound;
end;


procedure TPCSpeaker.Stop;
begin

NoSound;
end;


procedure TPCSpeaker.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;


function TPCSpeaker.GetPort(address: Word): Word;
var
bValue: Byte;
begin

asm
mov DX, address
in AL, DX
mov bValue, AL
end;

result := bValue;
end;


procedure Register;
begin

RegisterComponents('Sun', [TPCSpeaker]);
end;


end.

>>

还是自己用汇编吧！

zyy04 用汇编怎么实现？（麻烦举个例）

原来有过这个问题的答案（汇编程序），不过只能发出一种频率的声音，我想使发出声音
的声音象简单的音乐一样！

sunstone的这个控件实际上和原来提问中的那段程序一样，但我还想要得是一些声音例子，就象
“电子日记本”的“备忘录”中，有一些做好的声音可选！
或者给出每个调所对应的频率

附加功能 将问题提前

有一个叫PCSPEAKE的控件很不错,很多网站可下载到.
可设置声音频率和时间,还可编辑小音乐很不错.

用汇编吧
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
Tpcspeaker = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure NoSound;
procedure Sound(Freq: Word);
procedure SetPort(address, value: Word);
function GetPort(address: Word): Word;
{ Private declarations }
public
procedure Delay(MSecs: Integer);
procedure Play(Freq: Word;
MSecs: Integer);
{ Public declarations }
end;


var
pcspeaker: Tpcspeaker;

implementation

{$R *.DFM}
procedure TPCSpeaker.NoSound;
var
wValue: Word;
begin

wValue := GetPort($61);
wValue := wValue and $FC;
SetPort($61, wValue);
end;


procedure TPCSpeaker.Sound(Freq: Word);
var
B: Word;
begin

if Freq > 18 then
begin

Freq := Word(1193181 div LongInt(Freq));

B := GetPort($61);
B := GetPort($61);

if (B and 3) = 0 then
begin

SetPort($61, B or 3);
SetPort($43, $B6);
end;


SetPort($42, Freq);
SetPort($42, (Freq SHR 8));
end;

end;


procedure TPCSpeaker.Delay(MSecs: Integer);
var
FirstTickCount : LongInt;
begin

FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages;
{allowing access to other controls,
etc.}
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;



procedure TPCSpeaker.Play(Freq: Word;
MSecs: Integer);
begin

Sound(Freq);
Delay(MSecs);
//NoSound;
end;


procedure TPCSpeaker.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;


function TPCSpeaker.GetPort(address: Word): Word;
var
bValue: Byte;
begin

asm
mov DX, address
in AL, DX
mov bValue, AL
end;

result := bValue;
end;

procedure Tpcspeaker.Button1Click(Sender: TObject);
begin

play(1800,100);//由这两个参数控制音调
end;


procedure Tpcspeaker.Button2Click(Sender: TObject);
begin

NoSound;
end;


end.

to terry_lzs: 打扰，我用你的代码调试了一下，发现
asm
mov DX, address
in AL, DX /////这一行出错
mov bValue, AL
end;

to whb_li:我在我的电脑上用delphi 4和delphi 5都试过了，没有问题。
如果你是把网页上的直接拷贝到unit上请注意删除一些不可见的字符。
我以前有遇到这种问题的。

上面的控件不能在NT下运行？有什么办法

在nt下不能直接对端口操作，可以用api messagebeep
而在win9x下就不能用api，可以在代码里面根据系统选择实现方式

for i:=9 to 20do

windows.beep(i*130,20);

下载“良友的源代码”看一下。里面有许多不错的音乐编程示例　。

to 热水:
我没有“良友的源代码”，能给我发一个或告诉其下载地址

呀呀 鞋都跑丢了 不知能否帮上忙
(用API 如果有声卡 好像有点麻烦)
*------------------------------- DLL 的 dpr 代码 --------------
library SpeakSound;

//uses
// SysUtils,
// Classes,

procedure pcSound(dFreqouble;wLong:Word);export;
var
wFreq:word;
begin

wFreq := round(1192576/dFreq);
asm
push ax
push bx
push cx
push dx
push di
mov al,0B6H
out 43H,al
mov dx,12H
mov ax,wFreq
out 42H,al
mov al,ah
out 42H,al
in al,61H
mov ah,al
or al,3
out 61H,al
@wait1:
mov cx,wLong
@delay:
dec cx
jnz @delay
dec bx
jnz @wait1
mov al,0B6H
out 43H,al
mov al,ah
out 61H,al
pop di
pop dx
pop cx
pop bx
pop ax
end;

end;


exports
pcSound;

begin

end.

* ------------------------------ 调用的例子 ------------------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
DLLName:string;
Buffer:array[0..127] of Char;
LIB:THandle;
pcSoundrocedure(dFreqouble;wLong:Word);
begin

DLLName := 'SpeakSound.dll';
StrPCopy(Buffer,DLLName);
Lib := LoadLibrary(Buffer);
if not(Lib=0) then

try
pcSound := GetProcAddress(Lib,'pcSound');
pcsound(440.0,1000);
Finally
FreeLibrary(Lib);
end
else

Showmessage('failed');
end;


end.

{
261.7 c
293.7 d
329.6 e
349.2 f
392.0 g
440.0 a
493.9 b
}

AHM2000 Freeware 中有个PcSpeaker控件，带源码的，源码在AHM2000的主叶上有！