想用delphi编一个闹钟程序?

想用delphi编一个闹钟程序?,第1张

新建一个程序,并在窗体中加入以下元件:

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:reallong,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: TObjectvar 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:reallong,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: TObjectvar 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.

新建一个顺序,并在窗体中参与以下元件: Timer1: TTimerImage1: TImage。。时钟的表盘 Edit1: TEdit。。日期框 Label1: TLabelPopupMenu1: 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,当然,您假设嫌方法太烦,那吗最繁杂的, 到我的主页 下载完整的顺序代码) OK,在完成下面的方法后我们就可以在窗体的代码筐中输入以下代码。 unit Unit1interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,unit2, StdCtrls,inifiles,MMSystem, Menustype TForm1 = class(TForm) Timer1: TTimerImage1: TImageEdit1: TEditLabel1: TLabelPopupMenu1: TPopupMenupop1: TMenuItempop2: TMenuItempop4: TMenuItempop3: TMenuItempop5: TMenuItemN1: TMenuItemprocedure Timer1Timer(Sender: TObject)procedure timdrow(tim:reallong,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: TObjectvar Action: TCloseAction)procedure N1Click(Sender: TObject)private { Private declarations } public { Public declarations } endvar Form1: TForm1CLOCKBELL,wid,pofse:integertim1,tim2,tim3,tim4:realdtme: TDateTimetimini:tinifiledtim,textdef,tmfilename:stringimplementation {$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)endtimini。freeendprocedure tform1。timdrow(tim:reallong,col:integer)。。指针的进程函数。 var xx,yy:integervtt,vt:realbegin IF (TIM2=59) AND (TIM3=0) THEN TIM:=TIM-1IF (COL=3)or (col=6) THEN if col=3 then VT:=TIM1*5+(TIM2。720) else begin VT:=TIM1*5+((TIM2-1)。720)col:=5end ELSE vt:=timvt:=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))+45yy:=strtoint(floattostr(vtt))case col of 。。区分所要画的指针是 分针、秒针或时针 0:begin image1。Canvas。pen。Color:=clgrayimage1。Canvas。pen。Width:=1END1:BEGIN image1。Canvas。pen。Color:=clRedimage1。Canvas。pen。Width:=1END2:BEGIN image1。Canvas。pen。color:=clblueimage1。Canvas。pen。Width:=2END3:BEGIN image1。canvas。pen。color:=clgreenimage1。Canvas。pen。Width:=2END4:begin image1。canvas。pen。color:=clblackimage1。Canvas。pen。Width:=1END5:begin image1。canvas。pen。color:=clgrayimage1。Canvas。pen。Width:=3ENDendIMAGE1。Canvas。Ellipse(43,43,47,47)image1。Canvas。MoveTo(45,45)image1。Canvas。Lineto(xx,yy)endprocedure TForm1。Timer1Timer(Sender: TObject)var str1,str2:stringbegin str1:=timetostr(time())STR2:=COPY(STR1,2,1)if str2=':' then pofse:=0 else pofse:=1EDIT1。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:=tim4if 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:=12ENDIF CLOCKBELL>12 THEN CLOCKBELL:=CLOCKBELL-12timdrow(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)ENDif (pop3。checked)and(strtotime(dtim)<=time()) then。。区分能否到了定时的时间 begin form2。Button2。Caption:='吊销'clockbell:=120form2。Show。。显现给自己的提示。 endENDendprocedure TForm1。FormCreate(Sender: TObject)。。读入顺序开端的初始化设定 var str1,str2:stringbegin 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)endtimini。freedtme:=time()pop2。checked:=truepop1。Checked:=truestr1:=timetostr(time())STR2:=COPY(STR1,2,1)If str2=':' then pofse:=0 else pofse:=1image1。Canvas。BRUSH。COLOR:=CLBLACKstr2:=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:=-1endprocedure TForm1。Image1Click(Sender: TObject)。。表盘鼠标点击时的的处置 begin PopupMenu1。Popup(FORM1。LEFT+40,FORM1。TOP+150)endprocedure TForm1。pop1Click(Sender: TObject)begin if pop1。checked then pop1。checked:=false else pop1。checked:=trueform1。tiniwr()endprocedure TForm1。pop2Click(Sender: TObject)begin if pop2。checked then pop2。checked:=false else pop2。checked:=trueform1。tiniwr()endprocedure TForm1。pop4Click(Sender: TObject)begin form2。showform1。tiniwr()endprocedure TForm1。pop5Click(Sender: TObject)begin closeendprocedure TForm1。pop3Click(Sender: TObject)begin if pop3。Checked then begin pop3。Checked:=falseform2。Button2。Caption:='吊销'end else begin pop3。Checked:=trueform2。Button2。Caption:='封锁'endform1。tiniwr()endprocedure TForm1。FormClose(Sender: TObjectvar Action: TCloseAction)begin timini:=TIniFile。Create('tmfilename')with timini do begin Writeinteger('位置','X坐标',form1。Left)。。保管时钟窗口的初始 X 坐标 Writeinteger('位置','Y坐标',form1。top)。。保管时钟窗口的初始 Y 坐标 endtimini。freeendprocedure TForm1。N1Click(Sender: TObject)begin showmessage('模拟闹钟 0。1,'+#13+' Copy(R)ight by Suye。2001')endend。2011-10-24 5:46:18

不知你要的是什么闹钟,如果你要的是有走时图像的闹钟,这比较麻烦,因为要用CANVAS描绘出一个模拟时钟图像来,还要它的表盘指针按照系统时间不停的走,这不是十几句代码能解决的问题。不过DELPHI盒子上有现成的例子,你去搜索一下就得了。

如果你要的只时到某个时间,就响铃,这比较简单,用一个定时器,每分钟提取一次系统时间,然后把提取的时间转换为字符串,与你指定的响玲时间进行比对,如果两个时间相同,就播放一段音乐。


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/11539580.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-16
下一篇 2023-05-16

发表评论

登录后才能评论

评论列表(0条)

保存