この発言は
#00078　Athena          さんのアナログ時計の描画
に対するコメントです





Athenaさん：こんばんは〜  H-Tritonです。
これは楽しめるコードですね。
覚えたての知識でコンポーネントにしてみました。
TImageから派生しています。

ファイル名「AnaClock.pas」で保存してインストールします。
フォームに貼り付けて Intervalプロパティを適当な値にセットすると時計
が動き出します。

//--- ここから ---
unit AnaClock;

interface

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

type
  TAnaClock = class(TImage)
  private
    { Private 宣言 }
    FTimer: TTimer;
    FInterval: Cardinal;
    function GetX(Angle:Extended;R,CenterX:Integer) : Integer;
    function GetY(Angle:Extended;R,CenterY:Integer) : Integer;
    procedure SetInterval(Value: Cardinal);
    procedure DrawHands(Sender: TObject);
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    constructor Create( AOwner : TComponent ); override;
    destructor  Destroy; override;
  published
    { Published 宣言 }
    property Interval: Cardinal read FInterval write SetInterval;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TAnaClock]);
end;

// デストラクタ
destructor TAnaClock.Destroy;
begin
  FTimer.Free;
  inherited;
end;

// コンストラクタ
constructor TAnaClock.Create( AOwner : TComponent );
begin
  inherited Create( AOwner );
  FTimer:= TTimer.Create(Self);
  FTimer.OnTimer:= DrawHands;
  SetInterval(FInterval); //インターバル初期化
  DrawHands(nil);
end;

//ﾌﾟﾛﾊﾟﾃｨに値を書き込み、ﾀｲﾏｰのｲﾝﾀｰﾊﾞﾙを設定する
procedure TAnaClock.SetInterval(Value: Cardinal);
begin
  FInterval:= Value;
  FTimer.Interval:= FInterval;
end;

function TAnaClock.GetX(Angle:Extended;R,CenterX:Integer) : Integer;
var  E : Extended;
begin
  E := Sin(Angle);
  Result:=Round(R * E)+(CenterX); //針の先端Ｘ座標
end;

function TAnaClock.GetY(Angle:Extended;R,CenterY:Integer) : Integer;
var E: Extended;
begin
  E := -Cos(Angle);
  Result:=Round(R * E)+(CenterY); //針の先端Ｙ座標
end;

//針を描く
procedure TAnaClock.DrawHands(Sender: TObject);
const
   Rad : Extended= Pi / 180; //ラジアン値を求めるための定数
var
   AnS,AnM,AnH,Angle:Extended;
   X,Y,Len,CX,CY,i : Integer;
   Hour,Min,Sec,MSec : Word;
begin
    Canvas.Pen.Color:=clBlack;
    Canvas.Brush.Color:=clBtnFace;
    Canvas.FillRect(Clientrect); //前回の描画を消す
    Canvas.Brush.Color:=clWhite;
    CX := Width div 2; //中心の  X 座標
    CY := Height div 2;//中心の  Y 座標
    Canvas.Ellipse(CX-100,CY-100,CX+100,CY+100); //円を描画
    DecodeTime(Now, Hour, Min, Sec, MSec); //時刻を分解
    AnS :=  Sec * 6 * Rad;   //秒針の角度（ラジアン）
    AnM := (Min * 6  + Sec * 0.1)* Rad; //分針の角度（ラジアン）
    AnH := (Hour* 30 + Min * 0.5)* Rad; //時針の角度（ラジアン）

    for i := 0 to 2 do
    begin
        case i of
           0 : begin Canvas.Pen.Color:=clRed; Angle := AnH ; end;
           1 : begin Canvas.Pen.Color:=clBlue; Angle := AnM ; end;
           2 : begin Canvas.Pen.Color:=clAqua; Angle := AnS ; end;
        end;
        Len := i * 10 + 70 ;
        X:=GetX(AnS,Len,CX);
        Y:=GetY(AnS,Len,CY);
        Canvas.MoveTo(CX,CY);  //中心にペンを置く
        //線を引く
        Canvas.LineTo(GetX(Angle,Len,CX),GetY(Angle,Len,CY));
    end;
end;

end.
//---- ここまで ----

                ☆ Ｈ-Ｔriton (^^) since 1996 ☆
                      Avalon友の会第80008号
     ��玉でも石でもお預かりします FDELPHIサンプル蔵下足札番��

Original document by H-Triton        氏 ID:(QZV11422)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。