Delphi FMX 丸いアナログ時計 ソースコード ― 2022年08月20日 18:03
unit Unit1;
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.Menus;
type
TForm1 = class(TForm)
Image1: TImage;
Line1: TLine;
Line2: TLine;
Line3: TLine;
Timer1: TTimer;
PopupMenu1: TPopupMenu;
pmnSaishou: TMenuItem;
pmnSyuryo: TMenuItem;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
procedure pmnSaishouClick(Sender: TObject);
procedure pmnSyuryoClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ private 宣言 }
public
{ public 宣言 }
procedure TimeDisp;
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.TimeDisp;
var
h, m, s,ms : Word;
hh, mm, ss: single;
begin
DecodeTime(GetTime, h, m, s, ms);
// 秒針
ss := s + ms / 1000;
Line1.RotationAngle := 360.0 / 60.0 * ss - 90.0; // ０°は３時方向の為
// 分針
mm := m + s / 60.0;
Line2.RotationAngle := 360.0 / 60.0 * mm - 90.0;
// 時針
if (h > 12) then h := h - 12;
hh := h + m / 60.0; // 時針は分も加えて中間表現
Line3.RotationAngle := 360.0 / 12.0 * hh - 90.0;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
TimeDisp;
Timer1.Interval := 100;
Timer1.Enabled := True;
end;
procedure TForm1.FormResize(Sender: TObject);
var
w,h,a,r,cx,cy : single;
begin
// パネル再配置
w := Form1.ClientWidth;
h := Form1.ClientHeight;
a := w ;
if (a > h) then a := h;
if (a < 24) then a := 24;
cx:= w/2;
cy:= h/2;
r := a / 2;
// 秒針
with Line1 do begin
stroke.Thickness := a/250;
Position.X := cx - Line1.width * 0.2;
Position.Y := cy - Line1.Height * 0.5;
Width := r*1.2; // 長さ
end;
// 分針
with Line2 do begin
stroke.Thickness := a/60;
Position.X := cx;// - Line2.width * 0.2;
Position.Y := cy - Line2.Height * 0.5;
Width := r*0.8; // 長さ
end;
// 時針
with Line3 do begin
stroke.Thickness := a/40;
Position.X := cx;// - Line3.width * 0.2;
Position.Y := cy;// - stroke.Thickness * 01.0;
Width := r*0.6; // 長さ
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Timer1.Interval := 100;
Timer1.Enabled := True;
//FormResize(Self);
//Image1.Bitmap.LoadFromFile('img\banmen2.png');
Image1.Position.X := 0;
Image1.Position.Y := 0;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
var
p : TPointF ;
begin
if (ssRight in Shift) then begin
p := Form1.ClientToScreen(PointF(X,Y));
PopupMenu1.Popup(p.X,p.Y);
end;
StartWindowDrag;
end;
procedure TForm1.pmnSaishouClick(Sender: TObject);
begin
Form1.WindowState := TWindowState.wsMinimized;
end;
procedure TForm1.pmnSyuryoClick(Sender: TObject);
begin
form1.Close;
end;
end.
