Mam's WebSite
建築CGパース住宅CGパース

Mamの覚書Q&A検索

トップページMamの覚書Q&A検索Delphi(いろいろ)⇒Q&A


大項目:「 Delphi 」 - 中項目:「 いろいろ 」

「 背景が透明なアナログ時計を作成したい 」

デルファイで背景が透明なアナログ時計を作成したいのですが、どうすれば良いでしょうか。


回答

Delphiでは、いとも簡単に作成出来てしまいました(20分で作成できました)。
恐るべしDelphi・・・。以下はDelphi6以降での作成についてです。
 
1.Delphiを起動して新規アプリケーション(プロジェクト)を作成します。
2.フォームにTTimerを1つ置きます。(名前はTimer1)
3.Timer1の以下のプロパティを変更します
  Interval  50
4.フォーム(名前はForm1)の以下のプロパティを変更します。
  BorderStyle     bsNone
  ClientWidth     120
  ClientHeight    120
  Color           clSilver
  FormStyle       fsStayOnTop
  TransparentColor    True
  TransparentColorValue   clSilver
 
5.Unit1のUsesにDateUtilsを追加します。
  (DelphiのバージョンによってはMathユニットの追加が必要な場合があります。)
 
6.以下のソースコードを入力すれば完成です。

ソース

//①Timer1のOnTimerイベントに以下のソースを入力します
procedure TForm1.Timer1Timer(Sender: TObject);
var h,m,s:Extended;
    i:integer;
begin
  s:=SecondOf(now)+MilliSecondOf(now)/1000;
  m:=MinuteOf(now)+s/60;
  h:=HourOf(now)+m/60;
 
  //シルバー色で塗りつぶして透明にする
  Form1.Canvas.Brush.Color:=clSilver;
  Form1.Canvas.Brush.Style:=bsSolid;
  Form1.Canvas.FillRect(Form1.ClientRect);
 
  //文字盤の描画
  Form1.Canvas.Pen.Color:=clGreen;
  Form1.Canvas.Pen.Width:=4;
  Form1.Canvas.Pen.Style:=psSolid;
  for i:=0 to 11 do
  begin
    form1.Canvas.MoveTo(trunc(cos(i/6*pi-pi/2)*48)+60,
      trunc(sin(i/6*pi-pi/2)*48)+60);
    form1.Canvas.LineTo(trunc(cos(i/6*pi-pi/2)*50)+60,
      trunc(sin(i/6*pi-pi/2)*50)+60);
  end;
 
  //短針の描画
  Form1.Canvas.Pen.Color:=clBlue;
  Form1.Canvas.Pen.Width:=6;
  Form1.Canvas.MoveTo(60,60);
  Form1.Canvas.LineTo(trunc(cos(h/6*pi-pi/2)*26)+60,
  trunc(sin(h/6*pi-pi/2)*26)+60  );
 
  //長針の描画
  Form1.Canvas.Pen.Width:=3;
  Form1.Canvas.MoveTo(60,60);
  Form1.Canvas.LineTo(trunc(cos(m/30*pi-pi/2)*38)+60,
  trunc(sin(m/30*pi-pi/2)*38)+60  );
 
  //秒針の描画
  Form1.Canvas.Pen.Color:=clRed;
  Form1.Canvas.Pen.Width:=1;
  Form1.Canvas.MoveTo(60,60);
  Form1.Canvas.LineTo(trunc(cos(s/30*pi-pi/2)*48)+60,
  trunc(sin(s/30*pi-pi/2)*48)+60  );
end;
 
//②TForm1のOnMouseMoveに次のソースコードを入力します
//ドラッグで移動出来るようになります
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then
  begin
    ReleaseCapture;
    SendMessage(Handle,WM_SYSCOMMAND,SC_MOVE or 2,
      MakeLong(X,Y));
  end;
end;
 
//③TForm1のOnDblClickイベントに以下のソースを入力します
//ダブルクリックで終了できるようになります
procedure TForm1.FormDblClick(Sender: TObject);
begin
  Application.Terminate;
end;
 

//④タスクバーに表示させないようにするには、Project1に以下2カ所の修正をします。
program Project1;
uses
  Forms,Windows,               //<--ここにWindowsを追加する
  Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
  //以下の1行を追加する
  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


Mam's WebSite