1  unit StarU;
   2   
   3  interface
   4   
   5  uses
   6    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   7    ExtCtrls, StdCtrls;
   8   
   9  const
  10    MaxNo = 10;
  11  type
  12    TIroNo = 0..15;
  13    TStar = record
  14              N     : Integer;  // 頂点の数
  15              D     : Integer;  // ｋ番目とｋ＋ｄ番目を結ぶ
  16              XC    : Integer;  // 中心のｘ座標
  17              YC    : Integer;  // 中心のｙ座標
  18              R     : Integer;  // 半径
  19              Alpha : Integer;  // 始点の偏角
  20              IroNo : TIroNo;   // 16色の番号
  21              PlusAlpha : Integer; // αの増分
  22            end;
  23    TStarNo = 1..MaxNo;
  24    TStars  = array [TStarNo] of TStar;
  25    TFormStar = class(TForm)
  26      PanelMain: TPanel;
  27      ButtonClose: TButton;
  28      PanelChuushin: TPanel;
  29      EditXC: TEdit;
  30      EditYC: TEdit;
  31      PanelShiten: TPanel;
  32      EditR: TEdit;
  33      PanelKatachi: TPanel;
  34      EditN: TEdit;
  35      EditD: TEdit;
  36      ImageStar: TImage;
  37      ButtonDraw: TButton;
  38      ButtonClear: TButton;
  39      EditAlpha: TEdit;
  40      RadioGroupIro: TRadioGroup;
  41      ButtonKaiten: TButton;
  42      TimerKaiten: TTimer;
  43      procedure ButtonCloseClick(Sender: TObject);
  44      procedure ButtonDrawClick(Sender: TObject);
  45      procedure ButtonClearClick(Sender: TObject);
  46      procedure FormCreate(Sender: TObject);
  47      procedure ButtonKaitenClick(Sender: TObject);
  48      procedure TimerKaitenTimer(Sender: TObject);
  49    private
  50      { Private 宣言 }
  51      Star : TStar;
  52      Stars : TStars;
  53      procedure HoshiWoEgaku(Star : TStar);
  54      procedure DataWoYomu(var Star : TStar);
  55      procedure RandomData(var Star : TStar);
  56      procedure Kaiten(var Star : TStar);
  57    public
  58      { Public 宣言 }
  59    end;
  60   
  61  var
  62    FormStar: TFormStar;
  63   
  64  implementation
  65   
  66  {$R *.DFM}
  67  (******************** 一般のプロシージャ ********************)
  68  function  DegreeToRadian(Degree : Real) : Real;
  69            { 度 ⇒ ラジアン }
  70    begin
  71      DegreeToRadian := Degree/180*Pi;
  72    end; {DegreeToRadian}
  73   
  74  (******************** フォームのメソッド ********************)
  75  procedure TFormStar.HoshiWoEgaku(Star : TStar);
  76            { 星を描く }
  77  const
  78    Iro : array [TIroNo] of TColor
  79        = (clBlack,clMaroon,clGreen,clOlive, clNavy,clPurple, clTeal,clSilver,
  80           clGray, clRed,   clLime, clYellow,clBlue,clFuchsia,clAqua,clWhite );
  81  var
  82    Theta : Real;
  83    K : Byte;
  84  begin
  85    with ImageStar.Canvas, Star do
  86      begin
  87        Pen.Mode := pmNotXor;
  88        Pen.Color := Iro[IroNo];
  89        for K := 1 to N do
  90          begin
  91            Theta := DegreeToRadian(Alpha)+2*Pi/N*K;
  92            MoveTo(Round(XC+R*Cos(Theta)),Round(YC-R*Sin(Theta)));
  93            Theta := Theta+2*Pi/N*D;
  94            LineTo(Round(XC+R*Cos(Theta)),Round(YC-R*Sin(Theta)));
  95          end;
  96      end;
  97  end; {HoshiWoEgaku}
  98   
  99  procedure TFormStar.DataWoYomu(var Star : TStar);
 100            { 星のデータを読む }
 101  begin
 102    with Star do
 103      begin
 104        N := StrToInt(EditN.Text);
 105        D := StrToInt(EditD.Text);
 106        XC := StrToInt(EditXC.Text);
 107        YC := StrToInt(EditYC.Text);
 108        R := StrToInt(EditR.Text);
 109        Alpha := StrToInt(EditAlpha.Text);
 110        IroNo := RadioGroupIro.ItemIndex;
 111      end;
 112  end; {DataWoYomu}
 113   
 114  procedure TFormStar.RandomData(var Star : TStar);
 115            { 星のデータをランダムに設定する }
 116  begin
 117    with Star do
 118      begin
 119        N := Random(97)+3;
 120        D := Random(N-1)+1;
 121        XC := Random(ImageStar.Width);
 122        YC := Random(ImageStar.Height);
 123        R := Random(300);
 124        Alpha := Random(360);
 125        IroNo := Random(16);
 126        PlusAlpha := Random(11)-5;
 127      end;
 128  end; {RandomData}
 129   
 130  procedure TFormStar.Kaiten(var Star : TStar);
 131            { 星を回転する }
 132  //var
 133  //  IroNoHozon : TIroNo;
 134  begin
 135    with Star do
 136      begin
 137  //      IroNoHozon := IroNo;           // 色番号を保存
 138  //      IroNo := 15;                   // clWhite
 139        HoshiWoEgaku(Star);            // 消す
 140  //      IroNo := IroNoHozon;           // 元に戻す
 141        Alpha := Alpha+PlusAlpha;      // 偏角を１゜ふやす
 142        HoshiWoEgaku(Star);
 143      end;
 144  end; {Kaiten}
 145   
 146   
 147  (******************** イベントハンドラー ********************)
 148  procedure TFormStar.FormCreate(Sender: TObject);
 149  begin
 150    WindowState := wsMaximized;
 151    Randomize;
 152  end; {FormCreate}
 153   
 154  procedure TFormStar.ButtonCloseClick(Sender: TObject);
 155  begin
 156    Close;
 157  end; {ButtonCloseClick}
 158   
 159  procedure TFormStar.ButtonDrawClick(Sender: TObject);
 160  var
 161    K : TStarNo;
 162  begin
 163    DataWoYomu(Star);
 164    HoshiWoEgaku(Star);
 165    for K := 1 to MaxNo do
 166      begin
 167        RandomData(Stars[K]);
 168        HoshiWoEgaku(Stars[K]);
 169      end;
 170  end; {ButtonDrawClick　}
 171   
 172  procedure TFormStar.ButtonClearClick(Sender: TObject);
 173  begin
 174    with ImageStar.Canvas do
 175      begin
 176        FillRect(ClipRect);
 177      end;
 178  end; {ButtonClearClick}
 179   
 180  procedure TFormStar.ButtonKaitenClick(Sender: TObject);
 181  begin
 182    TimerKaiten.Enabled := not TimerKaiten.Enabled;
 183    if TimerKaiten.Enabled
 184      then begin
 185             ButtonKaiten.Caption := '停止(&S)';
 186             Star.PlusAlpha := Random(11)-5;
 187           end
 188      else ButtonKaiten.Caption := '回転(&R)';
 189  end; {ButtonKaitenClick}
 190   
 191  procedure TFormStar.TimerKaitenTimer(Sender: TObject);
 192  var
 193    K : Integer;
 194  begin
 195    K := Random(1000);
 196    if K < MaxNo
 197      then begin
 198             RandomData(Stars[K+1]);
 199             HoshiWoEgaku(Stars[K+1]);
 200           end;
 201    Kaiten(Star);
 202    for K := 1 to MaxNo do
 203      Kaiten(Stars[K]);
 204  end; {TimerKaitenTimer}
 205   
 206  end.