一个时钟的代码

unit U_Clock;

interfacehttp://download1.csdn.net/down3/20070612/12144636270.jpg

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons, MPlayer;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    GroupBox1: TGroupBox;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    Label1: TLabel;
    Label2: TLabel;
    Panel1: TPanel;
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    BitBtn1: TBitBtn;
    MediaPlayer1: TMediaPlayer;
    OpenDialog1: TOpenDialog;
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  AlertTime,PlayIng,firstTime:boolean;
  vho,vmo,vso:real;
  PoiLong:integer;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
begin
  PoiLong:=image1.Width div 2;//半径初始化
  DateTimePicker1.DateTime:=Now;
  PlayIng:=false;//闹钟的工作状态
  //绘制时间刻度
  with form1.Image1.Canvas do
  begin
    pen.Color:=clwhite;
    pen.Style:=pssolid;
    pen.Width:=1;
    brush.Color:=clwhite;
    rectangle(0,0,width,height);//画出白板
    pen.Color:=clblack;//画笔换成黑色
    for i:=1 to 60 do
    //绘制刻度,黑点
    begin
    if i mod 5=0 then
    begin//大刻度
      //中间点
      pixels[PoiLong+round(PoiLong*sin(i/60.0*2*pi)),
        PoiLong-round(PoiLong*cos(i/60.0*2*pi))]:=clblack;
      //上边点
      pixels[PoiLong+round(PoiLong*sin(i/60.0*2*pi)),
        PoiLong-round(PoiLong*cos(i/60.0*2*pi)-1)]:=clblack;
      //下边点
      pixels[PoiLong+round(PoiLong*sin(i/60.0*2*pi)),
        PoiLong-round(PoiLong*cos(i/60.0*2*pi)+1)]:=clblack;
      //左边点
      pixels[PoiLong+round(PoiLong*sin(i/60.0*2*pi))-1,
        PoiLong-round(PoiLong*cos(i/60.0*2*pi))]:=clblack;
      //右侧点
      pixels[PoiLong+round(PoiLong*sin(i/60.0*2*pi))+1,
        PoiLong-round(PoiLong*cos(i/60.0*2*pi))]:=clblack;
    end
    else//小刻度
      pixels[PoiLong+round(PoiLong*sin(i/60.0*2*pi)),
        PoiLong-round(PoiLong*cos(i/60.0*2*pi))]:=clblack;

    end;
  end;
  firstTime:=true;  //第一次运行为真,表盘指针
  AlertTime:=false; //开启闹铃为假(不开启)
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
Msec,sec,min,hour:word; //当前时间的
Msec2,sec2,min2,hour2:word;  //闹铃时间的
vh,vm,vs:real;  //弧度数

begin
  //设置时间为系统当前时间
  DateTimePicker1.DateTime:=Now;

  //分解时间
  DecodeTime(DatetimePicker1.Time,hour,min,sec,Msec);
  vs:=sec/60*2*pi;//秒针弧度
  vm:=min/60*2*pi+vs/60;//分针弧度
  vh:=hour/12*2*pi+vm/12;//时针弧度
  with Image1.Canvas do //画出各个指针
  begin

    if not firstTime then //若不是第一次走表,需要擦除上次的指针
    begin
      pen.Color:=clwhite; //白色线条

      //时针
      moveto(PoiLong,PoiLong);
      Lineto(PoiLong+round(PoiLong/1.9*sin(vho)),PoiLong-Round(PoiLong/1.9*cos(vho)));

      //分针
      moveto(PoiLong,PoiLong);
      Lineto(PoiLong+round(PoiLong/1.5*sin(vmo)),PoiLong-Round(PoiLong/1.5*cos(vmo)));

      //秒针
      moveto(PoiLong,PoiLong);
      Lineto(PoiLong+round(PoiLong/1.2*sin(vso)),PoiLong-Round(PoiLong/1.2*cos(vso)));
    end
    else
      firstTime:=false;
    pen.Color:=clblack;
    //时针
    moveto(PoiLong,PoiLong); //表盘中心
    Lineto(PoiLong+round(PoiLong/1.9*sin(vh)),PoiLong-Round(PoiLong/1.9*cos(vh)));

    //分针
    moveto(PoiLong,PoiLong);
    Lineto(PoiLong+round(PoiLong/1.5*sin(vm)),PoiLong-Round(PoiLong/1.5*cos(vm)));

    //秒针
    moveto(PoiLong,PoiLong);
    Lineto(PoiLong+round(PoiLong/1.2*sin(vs)),PoiLong-Round(PoiLong/1.2*cos(vs)));
    //MoveTo((left+width) div 2,height div 2);
    //LineTo((left+width) div 2+round(70*cos(pi/4.0-2*pi*sec/60.0)),height div 2+round(70*sin(pi/4.0-2*pi*sec/60.0)));
  end;
  //old,上一次时刻的弧度
  vho:=vh;
  vmo:=vm;
  vso:=vs;

  DecodeTime(DatetimePicker2.Time,hour2,min2,sec2,Msec2);
  if AlertTime and not PlayIng and(hour=hour2)and(min=min2)and (sec=sec2)  then
  begin
     MediaPlayer1.Play;//响闹铃
     playIng:=true;
  end;

end;


//闹铃的开启与取消
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if AlertTime then //取消定时
  begin
    MediaPlayer1.Stop;
    PlayIng:=false;
    AlertTime:=false;
    DateTimePicker2.Enabled:=True;
  end
  else  //定时
  begin
    if opendialog1.Execute then
      MediaPlayer1.FileName:=OpenDialog1.FileName
    else
      MediaPlayer1.FileName:='C:/WINDOWS/Media/Windows XP 启动.wav';

    MediaPlayer1.Open;
    AlertTime:=true;
    DateTimePicker2.Enabled:=false;
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  close;
end;

end. 

posted @ 2007-06-12 14:48  涛涌四海  阅读(166)  评论(0编辑  收藏  举报