アナログ時計ガジェットの作り方 ～Delphiソースコード集

• ホーム
• Delphiでお手軽プログラミング
• アナログ時計ガジェットの作り方 ～Delphiソースコード集

アナログ時計ガジェットの作り方 ～Delphiソースコード集

Delphiを起動して新規作成を行う

ソースコードの記述

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    procedure draw_clock;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  //タスクバーに表示させない設定
  Params.ExStyle := Params.ExStyle and not WS_EX_APPWINDOW;
  Params.WndParent := Application.Handle;
end;

procedure TForm1.draw_clock;
var wh:integer;
    h,m,s,ms:word;
    c:TPoint;
    rh,rm,rs:integer;
    i:integer;
begin
  //現在時刻を取り出す
  DecodeTime(GetTime(),h,m,s,ms);
  wh:=self.Width;//幅も高さも同じ

  rh:=wh div 2 * 6 div 10;//短針長さ
  rm:=wh div 2 * 7 div 10;//長針長さ
  rs:=wh div 2 * 8 div 10;//秒針長さ

  c.X:=wh div 2;
  c.Y:=wh div 2;
  //フォーム内部を塗りつぶす
  self.Canvas.Brush.Style:=bsSolid;
  self.Canvas.Brush.Color:=Self.Color;
  self.Canvas.Pen.Style:=psClear;
  self.Canvas.FillRect(Rect(0,0,self.ClientWidth,self.ClientHeight));
  //円を描画する
  self.Canvas.Brush.Style:=bsClear;
  self.Canvas.Pen.Style:=psSolid;
  self.Canvas.Pen.Width:=4;
  self.Canvas.Pen.Color:=RGB($80,$80,$80);
  self.Canvas.Ellipse(
    wh*2 div 100, wh*2 div 100,
    wh*98 div 100, wh*98 div 100
  );
  //目盛りの描画
  for i := 0 to 11 do
  begin
    self.Canvas.MoveTo(
      round(c.X+cos(i*30*pi/180)*wh/2*96/100),
      round(c.Y+sin(i*30*pi/180)*wh/2*96/100)
    );
    self.Canvas.LineTo(
      round(c.X+cos(i*30*pi/180)*wh/2*86/100),
      round(c.Y+sin(i*30*pi/180)*wh/2*86/100)
    );
  end;
  //短針を描く
  self.Canvas.Pen.Color:=RGB($60,$60,$FF);
  self.Canvas.Pen.Width:=12;
  self.Canvas.MoveTo(c.X,c.Y);
  self.Canvas.LineTo(
    round(c.X+rh*cos((h+m/60)/6*pi()-pi()/2)),
    round(c.Y+rh*sin((h+m/60)/6*pi()-pi()/2))
  );
  //長針を描く
  self.Canvas.Pen.Color:=RGB($80,$80,$FF);
  self.Canvas.Pen.Width:=6;
  self.Canvas.MoveTo(c.X,c.Y);
  self.Canvas.LineTo(
    round(c.X+rm*cos((m+s/60)/30*pi()-pi()/2)),
    round(c.Y+rm*sin((m+s/60)/30*pi()-pi()/2))
  );
  //秒針を描く
  self.Canvas.Pen.Color:=RGB($90,$90,$FF);
  self.Canvas.Pen.Width:=3;
  self.Canvas.MoveTo(c.X,c.Y);
  self.Canvas.LineTo(
    round(c.X+rs*cos((s+ms/1000)/30*pi()-pi()/2)),
    round(c.Y+rs*sin((s+ms/1000)/30*pi()-pi()/2))
  );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  self.TransparentColor:=true;
  self.TransparentColorValue:=Self.Color;
  self.BorderStyle:=bsNone;
  self.ClientWidth:=200;
  self.ClientHeight:=self.ClientWidth;
  draw_clock;
  //100ミリ秒ごとに描画
  timer1.Interval:=100;
  timer1.Enabled:=True;
  //常に最前面にウィンドウ位置を設定する
  SetWindowPos(self.Handle,HWND_TOPMOST,0,0,0,0,
    SWP_NOMOVE+SWP_NOSIZE
  );
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbLeft then
  begin
    //短針や長針や秒針等を左ボタンドラッグ時に移動させる
    ReleaseCapture;
    SendMessage(self.Handle, WM_SYSCOMMAND, SC_MOVE or 2, MakeLong(X, Y));
  end
  else if Button=mbRight then
  begin
    //短針や長針や秒針等を右ボタンクリック時はアプリ終了
    Application.Terminate;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  draw_clock;
end;

end.

実行する