上一页 1 2
有了上述发音函数后,就可以轻松地写出在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下通过.
上一页 1 2 |
