用 DELPHI 為 WINDOWS 做一個帶聲音的模擬鬧鐘
嗨，大家好。我是夢尋，這是我的第一次發帖子，請大家多多鼓勵、多多
支援，畢竟嘛，予人方便予己方便。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,當然，您如果嫌步驟太煩，那嗎最簡單的,
到我的主頁
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