谁能用Delphi让没有声卡的机子发出悦耳的声音?(100分)(100分)

  • 主题发起人 主题发起人 tpeisc
  • 开始时间 开始时间
T

tpeisc

Unregistered / Unconfirmed
GUEST, unregistred user!
我不太清楚这是不是比较底层,但我一点也不知道该如何去做。哈,,,,,
那位高手能告诉我,如何让机箱内的小喇叭发出一些悦耳的声音?比如在显示一些记录或执行特定操作的时候。
 
发声倒是可以,悦耳就谈不上了吧?
 
uses crt;
var
hz:word;
begin

hz:=262;//你要发出来的赫兹262
sound(hz);
delay(2000);
nosound;
end;

 
悦耳不可能。beep
 
我有一个想法,就是用dephi做一个在电影中看到那些数据库程序一样的东西(类似DOS下的),常看到他们能很漂亮地显示出数据来,而且机子也能发出一些短而好听的声音,所以才有这种想法。
把介面做成全黑色很好办,哈,,,,但声音却不好办,因为我也用过beep,但那太难听了。谁能有好办法的话,写出来,分还可能再多给些。
 
to tpeisc:
我不是回复了吗,用sound函数。uses crt
关于音高(频率),应该可以查到资料。
262赫兹好像就是C大调的Do
 
我试过你的代码了,在delphi6 winxp 运行不了。
系统不知道crt 是什么,也不知道sound函数是什么,哈,,,
你能写清楚些吗?
 
TO:太阳火
我也試過了不行啊,你是不是用其它控件!
 
不好意思,crt单元是turbo pascal 提供的。我以为Delphi也有。误导了,对不起。
 
有人能帮忙解决这个问题吗?
 
用现在的开发工具实现的确很难.如果用dos下的basic,tp等就很好实现.
记得我初中时用basic编了一个音乐程序,爆简单.哎,windows啊!
 
在Delphi使用嵌入汇编完全可以实现播放一段电子音乐,但这个做起来比较复杂,要处理把乐谱转换成发音的频率,时长等。我有个例子,就是用嵌入式汇编做的,不过乐谱要自己处理,要的话,说一声。咳咳,这年头赚分有点难。。。
 
to yangwei0308 :
方便的话,我也想要。。。。。。。。:)
lexiaoyaocyh@163.net
 
用汇编,让PC喇叭发声。

procedure sound(mhz : integer);
{mhz = the frequency of the pc speaker}
var
count : word;
oldport,
newport : byte;

begin

count := 1193280 div mhz;
asm
mov al,$b6
out $43,al
mov ax,count
out $42,al
mov al,ah
out $42,al
mov al,3
out $61,al
end;

end;


procedure nosound;
{turn off the pc speaker}
begin

asm
mov al,0
out $61,al
end;

end;
 
主要是让机内喇叭发出不同频率的声音,
至于实现请查阅一些Win api 或delphi内部涵数的书
 

看看吧:
让pc speaker美妙动听
在个人电脑上没有声卡、操作系统为16位DOS的时代,用PC SPEAKER(主板上的喇叭)发音曾经是唯一的选择。现在,时光已经进入32位的WINDOWS时代,几乎每台电脑上都装有声卡并且输出的声音也几近完美,人们渐渐将PC SPEAKER遗忘……。不过,当我们为了节省能源或不需要操作高品质声音而将音箱关掉时,是否可以请老古董PC SPEAKER 重出江湖,为我们做些有益的事情呢?比如,本人就用DELPHI写了一个让PC SPEAKER奏出不同的音调

模拟海关钟报时的小程序(当然在32位的视窗环境中)。下面就简述其发音原理及源程序的核心部分:


发音原理 : 在16位DOS环境中,用当时流行的开发工具(如FOXBASE,TC等)均能轻而易举地写出让PC SPEAKER发出不同音调的程序,不过在WIN32下,似乎有些小问题:翻遍WINAPI

只能找到唯一的一个能让PC SPEAKER发音的函数―Beep( dwFreq

dwDuration)其中,dwfreq为声音频率,单位为赫兹,dwDuration为声音长度,单位为毫秒。这两个参数仅在WINDOWS NT环境下有效,在WINDOWS 9X 下只能让PC SPEAKER发一声标准的beep音,毫无音调变化。怎么办? 经过努力

本人在网上找到了一个由英国人John Atkins用汇编写的操纵底层资源的发音函数:


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;


有了上述发音函数后

就可以轻松地写出在win9x环境下让主板喇叭奏乐报时的程序了:在Delphi的IDE环境下



建立一个新的工程

在其缺省的Form上放置一个捕捉整点时间的TTimer构件

取名为Timer1

将该构件的Interval属性设置为100(即0.1秒)

Enabled属性设为True

在该构件的OnTimer事件句柄中键入捕捉整点及奏乐报时的代码就基本上完成了该报时程序.


主要源代码如下:


unit Unit1;


interface


uses


Windows

Messages

SysUtils

Classes

Graphics

Controls

Forms

Dialogs



tdCtrls

ExtCtrls;


type


TForm1 = class(TForm)


Timer1: TTimer;


procedure Timer1Timer(Sender: TObject);


private  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}


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
file://将捕捉整点时间的精度控制在0.1秒内


begin



Timer1.Enabled :=false;


DecodeTime(Time

Hour

Min

Sec

MSec);//将时间解析出小时





毫秒


Beepfor(165

1000);
file://以下一段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;
file://到几点即敲几下钟(零点敲24下)


while hour>0do



begin



Beepfor(131

1000);


SlientFor(1000);


hour :=hour-1


end;



Timer1.Enabled :=true;


end;



end;



function _GetPort(address:word):word;


var


bValue: byte;


begin



此处代码见前述


end;



procedure _SetPort(address

Value:Word);


var


bValue: byte;


begin



此处代码见前述


end;



procedure StartBeep(Freq : Word);


var


B: Byte;


begin



此处代码见前述


end;



procedure StopBeep;


var


Value: Word;


begin



此处代码见前述


end;



end.


给分!

 
to 笑面虎:
能不能把你的这几个File打成一个包发给我,先谢啦!

xiaozymail@163.com
 
后退
顶部