⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 delphi编写的时钟程序
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  k:integer;
  changed:integer;
 
const
  pi=3.14159;

implementation

uses Unit2, Unit3, Unit4;

{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
var
  mynow:TDatetime;
  hour,min,sec,msec:Word;
  vh,vm,vs:Real;
  PoiLong:Integer;
begin
   mynow:=now;
   decodetime(mynow,hour,min,sec,msec);   //用相应的变量保存当前时间的小时\分钟\秒\毫秒
   vm:=min/60.0*2*pi;  //计算分钟值
   vh:=hour/12.0*2*pi+(vm/12);  //通过分钟计算小时
   vs:=sec/60.0*2*pi;  //计算秒值
   if N2.checked=false then
   begin
   with Form1.Canvas do
   begin
     PoiLong:=Form1.Width div 2; //设置表心位置
     //画时针
     Pen.Color:=clwhite;
     pen.Width:=4;
     Moveto(PoiLong,PoiLong);
     Form1.Refresh;
     Lineto(PoiLong+round(PoiLong/3.7*sin(vh)),PoiLong-Round(PoiLong/3.7*cos(vh)));
     //画分针
     Pen.Color:=clwhite;
     pen.Width:=2;
     Moveto(PoiLong,PoiLong);
     Lineto(PoiLong+round(PoiLong/2.3*sin(vm)),PoiLong-Round(PoiLong/2.3*cos(vm)));
     //画秒针
     Pen.Color:=clwhite;
     pen.Width:=1;
     Moveto(PoiLong,PoiLong);
     Lineto(PoiLong+round(PoiLong/1.7*sin(vs)),PoiLong-Round(PoiLong/1.7*cos(vs)));
  end;
  end;
  if N2.checked=true then
  begin
  with Form1.Canvas do
   begin
     PoiLong:=Form1.Width div 2; //设置表心位置
     //画时针
     Pen.Color:=hourcolor;
     pen.Width:=hourwidth;
     Moveto(PoiLong,PoiLong);
     Form1.Refresh;
     Lineto(PoiLong+round(PoiLong/3.7*sin(vh)),PoiLong-Round(PoiLong/3.7*cos(vh)));
     //画分针
     Pen.Color:=minutecolor;
     pen.Width:=minutewidth;
     Moveto(PoiLong,PoiLong);
     Lineto(PoiLong+round(PoiLong/2.3*sin(vm)),PoiLong-Round(PoiLong/2.3*cos(vm)));
     //画秒针
     Pen.Color:=secondcolor;
     pen.Width:=secondwidth;
     Moveto(PoiLong,PoiLong);
     Lineto(PoiLong+round(PoiLong/1.7*sin(vs)),PoiLong-Round(PoiLong/1.7*cos(vs)));
  end;
  end
end;
//--------以下这段代码在画针时,每次画过的痕迹都无法清除 ,请老师帮忙改正------
{var
  x1,y1:integer;
  a:real;
  datetime,hour,minute,second:Tdatetime;
begin
  Form1.Image1.Refresh;
  datetime:=time;
  hour:=datetime;
  if hour>=0.5 then
    hour:=hour-0.5;
  a:=hour*pi*4;
  x1:=round(sin(a)*40+120);
  y1:=round(120-cos(a)*40);
  Form1.Image1.canvas.pen.color:=clwhite;
  Form1.Image1.canvas.Pen.Width:=2;
  with Form1.Image1.Canvas do
  begin
    moveto(120,120);
    lineto(x1,y1);
  end;
  minute:=frac(datetime*24);
  a:=minute*2*pi;
  x1:=round(sin(a)*55+120);
  y1:=round(120-cos(a)*55);
  Form1.Image1.canvas.Pen.Color:=clwhite;
  Form1.Image1.canvas.Pen.Width:=1;
  with Form1.Image1.Canvas  do
  begin
    moveto(120,120);
    lineto(x1,y1);
  end;
  second:=frac(datetime*24*60);
  a:=second*2*pi;
  x1:=round(sin(a)*70+120);
  y1:=round(120-cos(a)*70);
  Form1.Image1.canvas.Pen.Color:=clwhite;
  Form1.Image1.canvas.Pen.Width:=1;
  with Form1.Image1.Canvas  do
  begin
    moveto(120,120);
    lineto(x1,y1);
  end;
   Form1.Image1.Refresh;
end;  }



procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
      ReleaseCapture;
      Perform(WM_SYSCOMMAND,$f012,0);
      //上面两句是用来拖动窗体
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  Form2.Show;
  Form1.visible:=false;

end;

procedure TForm1.N4Click(Sender: TObject);
var
  answer:integer;
begin
  answer:=MessageDlg('确定关闭程序?',mtConfirmation,[mbYes,mbNo],0);
  if answer=mrYes then
    close
  else
    ;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
   if N5.Checked=false then
   begin
      Form3.Show;
      N5.Checked:=True;
   end
   else
   begin
      Form3.Visible:=False;
      N5.Checked:=false;
   end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
    Form4.Show;
    N2.checked:=True;
    Form1.Visible:=False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    k:=1;
    //changed:=0;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -