说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

让pc speaker美妙动听-Delphi资料

HTML文档下载 WORD文档下载 PDF文档下载
让pc speaker美妙动听-Delphi资料

在个人电脑上没有声卡、操作系统为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>0 do

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.

以上代码在win98

Delphi5下通过.

备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘