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盒子上有现成的例子,你去搜索一下就得了。如果你要的只时到某个时间,就响铃,这比较简单,用一个定时器,每分钟提取一次系统时间,然后把提取的时间转换为字符串,与你指定的响玲时间进行比对,如果两个时间相同,就播放一段音乐。
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)