本文整理自网络，侵删。
unit main;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
FMX.Layouts, System.ImageList, FMX.ImgList, System.Actions, FMX.ActnList,
FMX.Controls.Presentation, FMX.StdCtrls;
type
TForm_main = class(TForm)
Circle1: TCircle;
ImageList1: TImageList;
ActionList1: TActionList;
Act_round: TAction;
StyleBook1: TStyleBook;
Timer1: TTimer;
Act_sec: TAction;
Act_min: TAction;
Act_hur: TAction;
Button1: TButton;
Timer2: TTimer;
procedure Act_roundExecute(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Act_secExecute(Sender: TObject);
procedure Act_minExecute(Sender: TObject);
procedure Act_hurExecute(Sender: TObject);
procedure Button1KeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
Shift: TShiftState);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_main: TForm_main;
s,m,h:integer;
implementation
uses Winapi.Windows;
{$R *.fmx}
procedure TForm_main.Act_roundExecute(Sender: TObject);
var
i,j,k:integer;
x,y:single;
t:TButton;
begin
j:=12;
k:=Round(Circle1.Height/2 - 60);
x:=(Circle1.Position.X + Circle1.Width/2);
y:=(Circle1.Position.Y + Circle1.Height/2);
for I := 1 to j do
begin
Application.ProcessMessages;
t:=TButton.Create(Self);
t.Parent:=Self;
if Screen.Height>736 then
t.Width:=60
else
t.Width:=50;
t.Height:=t.Width;
t.Images:=ImageList1;
t.ImageIndex:=0;
t.Position.X:=x+(k*Sin(i/j*Pi*2))-t.Width/2;
t.Position.Y:=y-(k*Cos(i/j*Pi*2))-t.Height/2;
t.TabStop:=False;
t.BringToFront;
end;
end;
procedure TForm_main.Act_hurExecute(Sender: TObject);
var
t:TButton;
i,j,k:integer;
x,y:single;
begin
if FindComponent('hur')=nil then
begin
t:=TButton.Create(Self);
t.Parent:=Self;
t.Name:='hur';
if Screen.Height>536 then
t.Width:=100
else
t.Width:=80;
t.Height:=t.Width;
t.Images:=ImageList1;
t.ImageIndex:=3;
t.BringToFront;
t.TabStop:=False;
end;
t:=findcomponent('hur')as TButton;
t.Text:='';
x:=(Circle1.Position.X + Circle1.Width/2);
y:=(Circle1.Position.Y + Circle1.Height/2);
k:=Round(Circle1.Height/2 - 260);
i:=h*60+m;
j:=720;
t.Position.X:=x+(k*Sin(i/j*Pi*2))-t.Width/2;
t.Position.Y:=y-(k*Cos(i/j*Pi*2))-t.Height/2;
end;
procedure TForm_main.Act_minExecute(Sender: TObject);
var
t:TButton;
i,j,k:integer;
x,y:single;
begin
if FindComponent('min')=nil then
begin
t:=TButton.Create(Self);
t.Parent:=Self;
t.Name:='min';
if Screen.Height>736 then
t.Width:=100
else
t.Width:=80;
t.Height:=t.Width;
t.Images:=ImageList1;
t.ImageIndex:=2;
t.BringToFront;
t.TabStop:=False;
end;
t:=findcomponent('min')as TButton;
t.Text:='';
x:=(Circle1.Position.X + Circle1.Width/2);
y:=(Circle1.Position.Y + Circle1.Height/2);
k:=Round(Circle1.Height/2 - 160);
i:=m;
j:=60;
t.Position.X:=x+(k*Sin(i/j*Pi*2))-t.Width/2;
t.Position.Y:=y-(k*Cos(i/j*Pi*2))-t.Height/2;
end;
procedure TForm_main.Act_secExecute(Sender: TObject);
var
t:TButton;
i,j,k:integer;
x,y:single;
begin
if FindComponent('sec')=nil then
begin
t:=TButton.Create(Self);
t.Parent:=Self;
t.Name:='sec';
if Screen.Height>736 then
t.Width:=100
else
t.Width:=80;
t.Height:=t.Width;
t.Images:=ImageList1;
t.ImageIndex:=1;
t.BringToFront;
t.TabStop:=False;
end;
t:=findcomponent('sec')as TButton;
t.Text:='';
x:=(Circle1.Position.X + Circle1.Width/2);
y:=(Circle1.Position.Y + Circle1.Height/2);
k:=Round(Circle1.Height/2 - 60);
i:=s;
j:=60;
t.Position.X:=x+(k*Sin(i/j*Pi*2))-t.Width/2;
t.Position.Y:=y-(k*Cos(i/j*Pi*2))-t.Height/2;
end;
procedure TForm_main.Button1KeyDown(Sender: TObject; var Key: Word;
var KeyChar: Char; Shift: TShiftState);
begin
if Key=27 then Application.Terminate;
end;
procedure TForm_main.FormCreate(Sender: TObject);
begin
Timer1.Enabled:=True;
ShowCursor(False);
end;
procedure TForm_main.Timer1Timer(Sender: TObject);
begin
if Timer1.Tag=0 then
begin
Act_round.Execute;
Timer1.Tag:=1;
m:=StrToInt(FormatDateTime('nn',now));
Act_min.Execute;
h:=StrToInt(FormatDateTime('hh',now));
Act_hur.Execute;
end;
s:=StrToInt(FormatDateTime('ss',now));
Act_sec.Execute;
if s=0 then
begin
m:=StrToInt(FormatDateTime('nn',now));
Act_min.Execute;
h:=StrToInt(FormatDateTime('hh',now));
Act_hur.Execute;
end;
if s=57 then Timer2.Enabled:=True;
end;
procedure TForm_main.Timer2Timer(Sender: TObject);
begin
if Timer2.Tag<5 then
begin
Application.ProcessMessages;
Winapi.Windows.Beep(2000,200);
Timer2.Tag:=Timer2.Tag + 1;
end
else
begin
Application.ProcessMessages;
Winapi.Windows.Beep(3000,300);
Timer2.Tag:=0;
Timer2.Enabled:=False;
end;
end;
end.
Delphi XE8 制作的萤光时钟，可改作屏保
网盘地址：http://pan.baidu.com/s/1gfECl4R
相关阅读 >>
Delphi xe增强的rtti妙用－－动态创建包中的窗口类
更多相关阅读请进入《Delphi》频道 >>
