分享
 
 
 

用 DELPHI 为 WINDOWS 做一个带声音的模拟闹钟

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

嗨,大家好。我是梦寻,这是我的第一次发帖子,请大家多多鼓励、多多

支持,毕竟嘛,予人方便予己方便。OK,转入正题,现在就来讲如何做一个带

响声的表盘式的 CLOCK。

首先我们应选择新建一个程序,并在窗体中加入以下元件:

Timer1: TTimer;

Image1: TImage;//时钟的表盘

Edit1: TEdit; //日期框

Label1: TLabel;

PopupMenu1: TPopupMenu;

而后在 {$R *.DFM} 下面加入这么一句 {$R CLOCKSOU.RES} <--时钟的声音文件,

(注:CLOCKSOU.RES 是先用windows的记事本新建一个文件,并加入以下几行

CLICKBEL WAVE "CLICKBEL.WAV"

TIMEBELL WAVE "TIMEBELL.WAV"

并存为文件 CLOCKSOU.RC 然后在 DOS解面下用BRCC32.exe 将 CLOCKSOU.RC 编译

为 DELPHI 格式的资源文件 CLOCOSOU.RES,当然,您如果嫌步骤太烦,那吗最简单的,

到我的主页 http://www.suye.8u8.com 下载完整的程序代码)

OK,在完成上面的步骤后我们就可以在窗体的代码筐中输入以下代码。

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls,unit2, StdCtrls,inifiles,MMSystem, Menus;

type

TForm1 = class(TForm)

Timer1: TTimer;

Image1: TImage;

Edit1: TEdit;

Label1: TLabel;

PopupMenu1: TPopupMenu;

pop1: TMenuItem;

pop2: TMenuItem;

pop4: TMenuItem;

pop3: TMenuItem;

pop5: TMenuItem;

N1: TMenuItem;

procedure Timer1Timer(Sender: TObject);

procedure timdrow(tim:real;long,col:integer);

procedure FormCreate(Sender: TObject);

procedure Image1Click(Sender: TObject);

procedure pop1Click(Sender: TObject);

procedure pop2Click(Sender: TObject);

procedure pop4Click(Sender: TObject);

procedure pop5Click(Sender: TObject);

procedure pop3Click(Sender: TObject);

procedure tiniwr();

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure N1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

CLOCKBELL,wid,pofse:integer;

tim1,tim2,tim3,tim4:real;

dtme: TDateTime;

timini:tinifile;

dtim,textdef,tmfilename:string;

implementation

{$R *.DFM}

{$R LL1.RES} //时钟的发声文件

procedure tform1.tiniwr();

begin

timini:=TIniFile.Create(tmfilename);

with timini do

begin

WriteString('内容','文字',textdef);

Writestring('参数','时间',dtim);

WriteBool('参数','报时允许',pop1.checked);

WriteBool('参数','秒响允许',pop2.checked);

WriteBool('参数','定时允许',pop3.checked);

end;

timini.free;

end;

procedure tform1.timdrow(tim:real;long,col:integer); //指针的过程函数。

var

xx,yy:integer;

vtt,vt:real;

begin

IF (TIM2=59) AND (TIM3=0) THEN TIM:=TIM-1;

IF (COL=3)or (col=6) THEN

if col=3 then VT:=TIM1*5+(TIM2/720)

else begin

VT:=TIM1*5+((TIM2-1)/720);

col:=5;

end

ELSE vt:=tim;

vt:=Pi-pi*vt/30-2*pi*(vt-15); //得出指针末端的 Y 坐标

vtt:=int(long*sin(vt))+45; //得出指针末端的 X 坐标

xx:=strtoint(floattostr(vtt));

vtt:=int(long*cos(vt))+45;

yy:=strtoint(floattostr(vtt));

case col of //判断所要画的指针是 分针、秒针或时针

0:begin

image1.Canvas.pen.Color:=clgray;

image1.Canvas.pen.Width:=1;

END;

1:BEGIN

image1.Canvas.pen.Color:=clRed;

image1.Canvas.pen.Width:=1;

END;

2:BEGIN

image1.Canvas.pen.color:=clblue;

image1.Canvas.pen.Width:=2;

END;

3:BEGIN

image1.canvas.pen.color:=clgreen;

image1.Canvas.pen.Width:=2;

END;

4:begin

image1.canvas.pen.color:=clblack;

image1.Canvas.pen.Width:=1;

END;

5:begin

image1.canvas.pen.color:=clgray;

image1.Canvas.pen.Width:=3;

END;

end;

IMAGE1.Canvas.Ellipse(43,43,47,47);

image1.Canvas.MoveTo(45,45);

image1.Canvas.Lineto(xx,yy);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

str1,str2:string;

begin

str1:=timetostr(time());

STR2:=COPY(STR1,2,1);

if str2=':' then pofse:=0 else pofse:=1;

EDIT1.TEXT:=' '+DATETOSTR(DATE()); //日期盘上的日期数据

str2:=copy(str1,pofse+6,2);

tim4:=strtofloat(str2);

if tim4<>tim3 then //判断是否到了移动指针的时间

begin

if (tim3=0) or (tim3=15) or (tim3=30)

or (tim3=45) then timdrow(tim3,39,4) else timdrow(tim3,39,0);

tim3:=tim4;

if pop2.checked then PlaySound(PChar('CLICKBEL'),

hInstance, snd_ASync or snd_Resource); //秒针的“滴答”发声

str2:=copy(str1,1,pofse+1);

IF(TIM3=0)AND(TIM2=59)THEN //判断是否到了发出整点报时“钟声”的时间

BEGIN

CLOCKBELL:=STRTOINT(STR2);

IF CLOCKBELL=0 THEN CLOCKBELL:=12;

END;

IF CLOCKBELL>12 THEN CLOCKBELL:=CLOCKBELL-12;

timdrow(tim1,26,6);

tim1:=strtofloat(str2);

timdrow(tim2,33,5);

str2:=copy(str1,pofse+3,2);

tim2:=strtofloat(str2);

timdrow(tim2,33,2);

IF (TIM2<>59) AND (TIM4<>0) THEN timdrow(tim1-1,26,3) ELSE TIMDROW(TIM1,26,3);

tim2:=strtofloat(str2);

str2:=copy(str1,pofse+3,2);

timdrow(tim3,39,1);

IF CLOCKBELL>-1 THEN

BEGIN

IF (CLOCKBELL<>0)and(pop2.checked) THEN

PlaySound(PChar('TIMEBELL'), hInstance,

snd_ASync or snd_Resource);//时钟的整点“钟声”发声

DEC(CLOCKBELL);

END;

if (pop3.checked)and(strtotime(dtim)<=time()) then//判断是否到了定时的时间

begin

form2.Button2.Caption:='取消';

clockbell:=120;

form2.Show; //显示给自己的提示。

end;

END;

end;

procedure TForm1.FormCreate(Sender: TObject); //读入程序开始的初始化设定

var

str1,str2:string;

begin

tmfilename:=ExtractFilePath(Application.EXEName)+'clock1.ini';

timini:=TIniFile.Create(tmfilename);

with timini do

begin

Textdef:=readString('内容','文字','在这里输入您给自己的提醒');

dtim:=readstring('参数','时间','23:59:59');

pop1.checked:=readBool('参数','报时允许',true);

pop2.checked:=readBool('参数','秒响允许',true);

pop3.checked:=readBool('参数','定时允许',false);

form1.Left:=readinteger('位置','X坐标',566);

form1.top:=readinteger('位置','Y坐标',8);

end;

timini.free;

dtme:=time();

pop2.checked:=true;

pop1.Checked:=true;

str1:=timetostr(time());

STR2:=COPY(STR1,2,1);

If str2=':' then pofse:=0 else pofse:=1;

image1.Canvas.BRUSH.COLOR:=CLBLACK;;

str2:=copy(str1,pofse+6,2);

tim3:=strtofloat(str2);

str2:=copy(str1,pofse+3,2);

tim2:=strtofloat(str2);

str2:=copy(str1,1,pofse+1);

tim1:=strtofloat(str2);

CLOCKBELL:=-1;

end;

procedure TForm1.Image1Click(Sender: TObject);//表盘鼠标点击时的的处理

begin

PopupMenu1.Popup(FORM1.LEFT+40,FORM1.TOP+150);

end;

procedure TForm1.pop1Click(Sender: TObject);

begin

if pop1.checked then pop1.checked:=false else pop1.checked:=true;

form1.tiniwr();

end;

procedure TForm1.pop2Click(Sender: TObject);

begin

if pop2.checked then pop2.checked:=false else pop2.checked:=true;

form1.tiniwr();

end;

procedure TForm1.pop4Click(Sender: TObject);

begin

form2.show;

form1.tiniwr();

end;

procedure TForm1.pop5Click(Sender: TObject);

begin

close;

end;

procedure TForm1.pop3Click(Sender: TObject);

begin

if pop3.Checked then

begin

pop3.Checked:=false;

form2.Button2.Caption:='取消';

end

else

begin

pop3.Checked:=true;

form2.Button2.Caption:='关闭';

end;

form1.tiniwr();

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

timini:=TIniFile.Create('tmfilename');

with timini do

begin

Writeinteger('位置','X坐标',form1.Left);//保存时钟窗口的初始 X 坐标

Writeinteger('位置','Y坐标',form1.top);//保存时钟窗口的初始 Y 坐标

end;

timini.free;

end;

procedure TForm1.N1Click(Sender: TObject);

begin

showmessage('模拟闹钟 0.1,'+#13+'Copy(R)ight by Suye.2001');;

end;

end.

好了,经过以上的一些操作后,我们的一个闹钟就几呼完成了,您只要做一些

小变化就全部完成了,OK,就聊到这,您如果还有什么问题,欢迎到我的主页

http://www.suye.8u8.com 询问,说不定您将会得到不错的收获哦。

梦寻,2001.02.04

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有