unit1.pas

很多 delphi 精彩小例子。供大家参考。

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Image1Click(Sender: TObject);
  private
    { Private declarations }
    FirstTime     : Boolean;
    vho, vmo, vso : Real;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  with Form1.Image1.Canvas do begin
    Pen.Color := clWhite;
    Pen.Style := psSolid;
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    Rectangle(0,0,Width,Height);

    Pen.Color := clBlack;
    for i:=1 to 12 do
      Pixels[60+Round(60*Sin(i/12.0*2*Pi)),60-Round(60*Cos(i/12.0*2*Pi))] := clBlack;
  end;

  FirstTime := True;

  Form1.Panel1.Left := 0;
  Form1.Panel1.Top := 0;
  Form1.Width := Form1.Panel1.Width;
  Form1.Height := Form1.Panel1.Height;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  MyNow      : TDateTime;
  Hour, Min,
  Sec, mSec  : Word;
  vh, vm, vs : Real;
begin
  MyNow := Now;
  DecodeTime(MyNow,Hour,Min,Sec,mSec);

  vh := Hour/12.0*2*Pi;
  vm := Min/60.0*2*Pi;
  vs := Sec/60.0*2*Pi;

  with Form1.Image1.Canvas do begin
    if not FirstTime then begin
      Pen.Color := clWhite;
      MoveTo(60,60);
      LineTo(60+Round(38*Sin(vho)),60-Round(38*Cos(vho)));
      MoveTo(60,60);
      LineTo(60+Round(55*Sin(vmo)),60-Round(55*Cos(vmo)));
      MoveTo(60,60);
      LineTo(60+Round(55*Sin(vso)),60-Round(55*Cos(vso)));
    end
    else
      FirstTime := False;
    Pen.Color := clBlack;
    MoveTo(60,60);
    LineTo(60+Round(35*Sin(vh)),60-Round(35*Cos(vh)));
    Pen.Color := clBlue;
    MoveTo(60,60);
    LineTo(60+Round(55*Sin(vm)),60-Round(55*Cos(vm)));
    Pen.Color := clRed;
    MoveTo(60,60);
    LineTo(60+Round(55*Sin(vs)),60-Round(55*Cos(vs)));
  end;

  vho := vh;
  vmo := vm;
  vso := vs;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
close
end;

end.