模拟物理时钟
有闹铃.秒表设置.用DELPHPI+ACCESS 完成
只是为了学习
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, Mask, jpeg, DB, ADODB, MPlayer,
Buttons, TeeProcs, TeEngine, Chart;
type
TForm1 = class(TForm)
Timer1: TTimer;
PageControl1: TPageControl;
t_show: TTabSheet;
T_ring: TTabSheet;
Label1: TLabel;
Label2: TLabel;
r_1: TCheckBox;
r_2: TCheckBox;
r_3: TCheckBox;
m_show: TTabSheet;
m_start: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
MaskEdit2: TMaskEdit;
MaskEdit3: TMaskEdit;
MaskEdit4: TMaskEdit;
Edit1: TEdit;
show: TButton;
Button6: TButton;
Label3: TLabel;
Label6: TLabel;
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
OpenDialog1: TOpenDialog;
Edit2: TEdit;
MediaPlayer1: TMediaPlayer;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
Edit4: TEdit;
BitBtn6: TBitBtn;
Edit3: TEdit;
Button7: TButton;
Label7: TLabel;
Image2: TImage;
PaintBox1: TPaintBox;
CheckBox1: TCheckBox;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
c_hour: TMaskEdit;
c_min: TMaskEdit;
Label5: TLabel;
UpDown1: TUpDown;
UpDown2: TUpDown;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure m_startClick(Sender: TObject);
procedure showClick(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Edit2Click(Sender: TObject);
procedure Edit4Click(Sender: TObject);
procedure Edit3Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure r_1Click(Sender: TObject);
procedure r_2Click(Sender: TObject);
procedure r_3Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private declarations }
public
procedure musicplay(musicpath,musicname:string);overload;
procedure musicplay(musicfilename:string);overload;
procedure adoselect; //检索数据库信息
procedure timechange; //时间变更
procedure clockpaint; //画物理时钟
procedure showtime; //显示时间
procedure ring; //闹铃和报时
{ Public declarations }
end;
var
Form1: TForm1;
Hour:integer;
Min :integer;
Sec :integer;
x:double;
y:double;
i:integer;
m_hour:integer;
m_min:integer;
m_sec:integer;
m_mm:integer;
t_start:boolean;
r_1_click:boolean;
r_1_time:string;
r_1_music:string;
r_2_click:boolean;
r_2_time:string;
r_2_music:string;
r_3_click:boolean;
r_3_time:string;
r_3_music:string;
str_music1:string;
str_music2:string;
str_music3:string;
implementation
{$R *.dfm}
procedure tform1.musicplay(musicpath,musicname:string);
var str:string;
begin
//音乐播放1
if musicpath='' then
musicpath:=extractfilepath(application.Name);
str:=musicpath+musicname;
if fileexists(str) then begin
//form1.MediaPlayer1.Stop;
form1.MediaPlayer1.FileName:=str;
form1.MediaPlayer1.Open;
form1.MediaPlayer1.Play;
//button7.Visible:=true
end
end;
procedure tform1.musicplay(musicfilename:string);
begin
//音乐播放2
if fileexists(musicfilename) then begin
form1.MediaPlayer1.Stop;
form1.MediaPlayer1.FileName:=musicfilename;
form1.MediaPlayer1.Open;
form1.MediaPlayer1.Play;
//button7.Visible:=true
end
end;
procedure tform1.adoselect;
var filepath:string;
begin
//先获得文件路径
Filepath:=extractfilepath(application.exename);
//添加闹铃设置
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add('select * from ring where tno=1');
adoquery1.Open;
r_1_click:=adoquery1.FieldByName('tf').Value;
r_1.Checked:=r_1_click;
r_1_time:=adoquery1.FieldByName('tim').Value;
maskedit2.Text:=r_1_time;
r_1_music:=adoquery1.FieldByName('music').Value;
//showmessage(r_1_music);
if(fileexists(r_1_music)) then
str_music1:=r_1_music
else begin
str_music1:=Filepath+'music\def.wma';
r_1_music:=str_music1;
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add('update ring set music= "'+str_music1+'" where tno=1');
adoquery1.ExecSQL;
end;
edit2.Text:=extractfilename(str_music1);
r_1.OnClick(r_1);
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add('select * from ring where tno=2');
adoquery1.Open;
r_2_click:=adoquery1.FieldByName('tf').Value;
r_2.Checked:=r_2_click;
r_2_time:=adoquery1.FieldByName('tim').Value;
maskedit3.Text:=r_2_time;
r_2_music:=adoquery1.FieldByName('music').Value;
if fileexists(r_2_music) then
str_music2:=r_2_music
else begin
str_music2:=Filepath+'music\def.wma';
r_2_music:=str_music2;
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add('update ring set music= "'+str_music2+'" where tno=2');
adoquery1.ExecSQL;
end;
//showmessage(str_music2);
edit3.Text:=extractfilename(str_music2);
//showmessage(edit3.Text);
r_2.OnClick(r_2);
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add('select * from ring where tno=3');
adoquery1.Open;
r_3_click:=adoquery1.FieldByName('tf').Value;
r_3.Checked:=r_3_click;
r_3_time:=adoquery1.FieldByName('tim').Value;
maskedit4.Text:=r_3_time;
r_3_music:=adoquery1.FieldByName('music').Value;
if fileexists(r_3_music) then
str_music3:=r_3_music
else begin
str_music3:=Filepath+'music\def.wma';
r_3_music:=str_music3;
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add('update ring set music= "'+str_music3+'" where tno=3');
adoquery1.ExecSQL;
end;
edit4.Text:=extractfilename(str_music3);
r_3.OnClick(r_3);
end;
procedure tform1.timechange;
begin
//时钟显示时间计算
if(sec=59)then
begin
if(min=59)then
begin
if(hour>24) then
hour:=hour mod 24;
hour:=hour+1;
min:=0;
sec:=0
end
else
begin
min:=min+1;
sec:=0
end
end
else
begin
sec:=sec+1;
end;
end;
procedure tform1.clockpaint;
begin
//刷新界面
paintbox1.Repaint;
//秒针的定位赋值
x:=70*sin(2*pi*(sec/60.0));
y:=70*cos(2*pi*(sec/60.0));
//画出秒针
//canvas.FreeInstance;
paintbox1.canvas.Pen.Width:=2;
paintbox1.canvas.MoveTo(130,140);
paintbox1.canvas.LineTo((130+trunc(x)),(140-trunc(y)));
//分针的定位赋值
x:=50*sin(2*pi*(min/60.0+sec/3600.0));
y:=50*cos(2*pi*(min/60.0+sec/3600.0));
//画出分针
paintbox1.canvas.Pen.Color:=clblack;
paintbox1.canvas.Pen.Width:=3;
paintbox1.canvas.MoveTo(130,140);
paintbox1.canvas.LineTo((130+trunc(x)),(140-trunc(y)));
//时针的定位赋值
x:=40*sin(2*pi*(hour/12.0+min/720.0+sec/43200.0));
y:=40*cos(2*pi*(hour/12.0+min/720.0+sec/43200.0));
//画出时针
paintbox1.canvas.Pen.Width:=4;
paintbox1.canvas.MoveTo(130,140);
paintbox1.canvas.LineTo((130+trunc(x)),(140-trunc(y)));
end;
procedure tform1.showtime;
var str_hour,str_min,str_sec:string;
begin
//时间格式化
if(hour<10) then
str_hour:='0'+inttostr(hour)
else str_hour:=inttostr(hour);
if(min<10) then
str_min:='0'+inttostr(min)
else str_min:=inttostr(min);
if(sec<10) then
str_sec:='0'+inttostr(sec)
else str_sec:=inttostr(sec);
//获取系统时间
label1.Caption:='系统时间:'+ formatdatetime('HH:NN:SS',time);
label2.Caption:='时钟时间为:'+str_hour+':'+str_min+':'+str_sec;
label3.Caption:=str_hour+':'+str_min;
end;
procedure tform1.ring;
begin
//整点报时
if (min=00) then
if(sec=00) then begin
//form1.musicplay('','music\ring.wav');
form1.musicplay('music\ring.wav');
end;
//定时闹钟1
if(r_1_click) then
if(r_1_time=label3.Caption) and(sec=0) then begin
//form1.MediaPlayer1.Stop
form1.musicplay(r_1_music);
button7.Caption:='关闭闹铃';
button7.Visible:=true
end;
//定时闹钟2
if(r_2_click) then
if(r_2_time=label3.Caption) and(sec=0) then begin
//form1.MediaPlayer1.Stop
form1.musicplay(r_2_music);
button7.Caption:='关闭闹铃';
button7.Visible:=true;
end;
//定时闹钟3
if(r_3_click) then
if(r_3_time=label3.Caption) and(sec=0) then begin
//form1.MediaPlayer1.Stop
form1.musicplay(r_3_music);
button7.Caption:='关闭闹铃';
button7.Visible:=true
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var s:string;
begin
form1.DoubleBuffered:=true;
S:=formatDateTime('HH:MM:SS',Time);
Hour:=strtoint(Copy(S, 1, 2));
Min:=strtoint(Copy(s, 4, 2));
Sec:=strtoint(Copy(S, 7, 2));
button7.Visible:=false;
form1.MediaPlayer1.FileName:='music\def.wma';
form1.MediaPlayer1.open;
form1.MediaPlayer1.Stop;
form1.adoselect;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
form1.timechange;
form1.clockpaint;
form1.showtime;
form1.ring;
end;
procedure TForm1.Button1Click(Sender: TObject);
var s:string;
begin
//SysUtils.DecodeTime(now,Hour,Min,Sec,);
S:=formatDateTime('HH:MM:SS',Time);
Hour:=strtoint(Copy(S, 1, 2));
Min:=strtoint(Copy(s, 4, 2));
Sec:=strtoint(Copy(S, 7, 2));
end;
procedure TForm1.m_startClick(Sender: TObject);
var lgtick1,lgtick2,lgper:tlargeinteger;
ftemp:single;
iten:integer;
ms_hour,ms_min,ms_sec,ms_mm:string;
begin
if m_start.caption='开始' then
begin
m_start.caption:='停止';
t_start:=true;
//求出1毫秒时钟震动的次数
queryperformancefrequency(lgper);
ftemp:=lgper/1000;
// 求出10毫秒时钟震动的次数
iten:=trunc(ftemp*10);
queryperformancecounter(lgtick1);
lgtick2:=lgtick1;
while t_start do begin
queryperformancecounter(lgtick2);
//如果时钟震动次数超过10毫秒的次数则刷新edit3的显示
if lgtick2 -lgtick1 >=iten then begin
lgtick1:=lgtick2;
//m_hour:=(m_hour+(m_min+(m_sec+(m_mm+1) div 100)div 60)div 60) mod 24;
//m_min:=(m_min+(m_sec+(m_mm+1) div 100)div 60) mod 60;
//m_sec:=(m_sec+(m_mm+1) div 100) mod 60;
//m_mm:=(m_mm+1)mod 100;
if(m_mm=99) then
begin
if(m_sec=59)then
begin
if(m_min=59)then
begin
m_hour:=m_hour+1;
m_min:=0
end
else
begin
m_min:=m_min+1;
m_sec:=0
end
end
else
begin
m_sec:=m_sec+1;
m_mm:=0
end
end
else
m_mm:=m_mm+1;
//时间格式化
if(m_hour<10) then
ms_hour:='0'+inttostr(m_hour)
else ms_hour:=inttostr(m_hour);
if(m_min<10) then
ms_min:='0'+inttostr(m_min)
else ms_min:=inttostr(m_min);
if(m_sec<10) then
ms_sec:='0'+inttostr(m_sec)
else ms_sec:=inttostr(m_sec);
if(m_mm<10) then
ms_mm:='0'+inttostr(m_mm)
else ms_mm:=inttostr(m_mm);
edit1.Text:=ms_hour+':'+ms_min+':'+ms_sec+':'+ms_mm;
//edit1.Text:=inttostr(m_hour)+':'+inttostr(m_min)+':'+inttostr(m_sec)+':'+inttostr(m_mm);
application.processmessages;
end
end;
end
else
begin
m_start.caption:='开始';
t_start:=false;
end
end;
procedure TForm1.showClick(Sender: TObject);
begin
if show.Caption='设置'then
begin
form1.Width:=485;
show.caption:='隐藏';
end
else
begin
form1.Width:=290;
show.caption:='设置';
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
//时间重新设定
hour:=strtoint(c_hour.Text);
min:=strtoint(c_min.Text)
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
m_start.caption:='开始';
t_start:=false;
show.Click;
edit1.Text:='';
m_mm:=0;
end;
procedure TForm1.Edit2Click(Sender: TObject);
begin
form1.OpenDialog1.Title:='请选择铃声文件';
if form1.OpenDialog1.Execute then
begin
str_music1:=form1.OpenDialog1.FileName;
edit2.Text:=extractfilename(str_music1);
BitBtn1.Visible:=true;
end
end;
procedure TForm1.Edit3Click(Sender: TObject);
begin
form1.OpenDialog1.Title:='请选择铃声文件';
if form1.OpenDialog1.Execute then
begin
str_music2:=form1.OpenDialog1.FileName;
edit3.Text:=extractfilename(str_music2);
BitBtn3.Visible:=true;
end
end;
procedure TForm1.Edit4Click(Sender: TObject);
begin
form1.OpenDialog1.Title:='请选择铃声文件';
if form1.OpenDialog1.Execute then
begin
str_music3:=form1.OpenDialog1.FileName;
edit4.Text:=extractfilename(str_music3);
BitBtn5.Visible:=true;
end
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
bitbtn1.Visible:=false;
bitbtn2.Visible:=true;
r_2.OnClick(r_2);
r_3.OnClick(r_3);
form1.musicplay(str_music1);
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
form1.MediaPlayer1.Stop;
r_1.OnClick(r_1);
r_2.OnClick(r_2);
r_3.OnClick(r_3);
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
r_1.OnClick(r_1);
bitbtn3.Visible:=false;
bitbtn4.Visible:=true;
r_3.OnClick(r_3);
form1.musicplay(str_music2);
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
begin
r_1.OnClick(r_1);
r_2.OnClick(r_2);
bitbtn5.Visible:=false;
bitbtn6.Visible:=true;
form1.musicplay(str_music3);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
//第一个闹铃的信息保存
adoquery1.Close;
adoquery1.SQL.Clear;
if r_1.Checked then
adoquery1.SQL.Add('update ring set tf= true ,tim="' +maskedit2.Text+'",music= "'+str_music1+'" where tno=1')
else
adoquery1.SQL.Add('update ring set tf= false where tno=1');
adoquery1.ExecSQL;
r_1_click:=r_1.Checked;
r_1_time:=maskedit2.Text;
//showmessage(r_1_time);
r_1_music:=str_music1;
//showmessage(r_1_music);
//第二个闹铃的信息保存
adoquery1.Close;
adoquery1.SQL.Clear;
if r_2.Checked then
adoquery1.SQL.Add('update ring set tim="' +maskedit3.Text+'",tf= true ,music= "'+str_music2+'" where tno=2')
else
adoquery1.SQL.Add('update ring set tf= false where tno=2');
adoquery1.ExecSQL;
r_2_click:=r_2.Checked;
r_2_time:=maskedit3.Text;
r_2_music:=str_music2;
//第三个闹铃的信息保存
adoquery1.Close;
adoquery1.SQL.Clear;
if r_3.Checked then
adoquery1.SQL.Add('update ring set tim="' +maskedit4.Text+'",tf= true ,music= "'+str_music3+'" where tno=3')
else
adoquery1.SQL.Add('update ring set tf= false where tno=3');
adoquery1.ExecSQL;
r_3_click:=r_3.Checked;
r_3_time:=maskedit4.Text;
r_3_music:=str_music3;
show.Click;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
r_1.Checked:=r_1_click;
r_1.OnClick(r_1);
r_2.Checked:=r_2_click;
r_2.OnClick(r_2);
r_3.Checked:=r_3_click;
r_3.OnClick(r_3);
form1.adoselect;
show.Click;
end;
procedure TForm1.r_1Click(Sender: TObject);
begin
if r_1.Checked then
begin
maskedit2.Visible:=true;
edit2.Visible:=true;
bitbtn1.visible:=true;
bitbtn2.visible:=false;
end
else
begin
maskedit2.Visible:=false;
edit2.Visible:=false;
form1.MediaPlayer1.Stop;
bitbtn1.visible:=false;
bitbtn2.visible:=false;
end
end;
procedure TForm1.r_2Click(Sender: TObject);
begin
if r_2.Checked then
begin
maskedit3.Visible:=true;
edit3.Visible:=true;
bitbtn3.visible:=true;
bitbtn4.visible:=false;
end
else
begin
maskedit3.Visible:=false;
edit3.Visible:=false;
form1.MediaPlayer1.Stop;
bitbtn3.visible:=false;
bitbtn4.visible:=false;
end
end;
procedure TForm1.r_3Click(Sender: TObject);
begin
if r_3.Checked then
begin
maskedit4.Visible:=true;
edit4.Visible:=true;
bitbtn5.visible:=true;
bitbtn6.visible:=false;
end
else
begin
maskedit4.Visible:=false;
edit4.Visible:=false;
form1.MediaPlayer1.Stop;
bitbtn5.visible:=false;
bitbtn6.visible:=false;
end
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
form1.MediaPlayer1.Stop;
button7.Visible:=false;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if checkbox1.Checked then
panel1.Visible:=true
else
panel1.Visible:=false;
end;
end.
[ 本帖最后由 whqfd 于 2007-10-18 11:35 编辑 ]
 附件: 您所在的用户组无法下载或查看附件
|
