// Mein Versuch ein eigenes "Starfield" zu programmieren. Die Variable "wrong"
// bestimmt dabei die Richtung der sogenannten Sterne und wird mittels Mausklick
// umgeschaltet. Ein beliebiger Tastendruck beendet das Programm.

// Getestet mit D2010 unter Win7
 

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
  StdCtrls, ExtCtrls; 
 
type 
  TArea = (arTopLeft, arTopRight, arBottomLeft, arBottomRight); 
 
  Str = record 
    lg, angle: Single; 
    x, y, stp: Integer; 
    w: TArea; 
    cl: TColor; 
  end; 
 
  TForm1 = class(TForm) 
    Timer1: TTimer; 
    procedure FormCreate(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 
    procedure FormClick(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
    procedure Build; 
    procedure MakeStars; 
    procedure One(I: Integer; wich: TArea); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses math; 
 
const 
  BackColor = clBlack; 
 
var 
  MStar: array of Str; 
  cnv: TCanvas; 
  Rct: TRect; 
  Stars, TopLeft, TopRight, BottomLeft, BottomRight, OriginX, OriginY: Integer; 
 
  wrong: Boolean = False; 
 
procedure TForm1.MakeStars; 
var 
  I: Integer; 
  function newpoint: Boolean; 
  var 
    d: Integer; 
  begin 
    d := Random(TopLeft) + 3; 
    with MStar[I] do 
    begin 
      x := Trunc(OriginX + Cos(angle) * lg); 
      y := Trunc(OriginY + Sin(angle) * lg); 
      if wrong then 
        Result := sqr(OriginX - x) + sqr(OriginY - y) < sqr(d) 
      else 
        Result := (x < Rct.Left) or (y < Rct.Top) or (x > Rct.Right) or 
          (y > Rct.Bottom) 
    end; 
  end; 
 
begin 
  for I := 0 to Stars - 1 do 
    with MStar[I] do 
    begin 
      setpixel(cnv.Handle, x, y, BackColor); 
      if wrong then 
        lg := lg - stp 
      else 
        lg := lg + stp; 
      if newpoint then 
        One(I, w) 
      else 
        setpixel(cnv.Handle, x, y, cl); 
    end; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  MakeStars; 
end; 
 
procedure TForm1.One(I: Integer; wich: TArea); 
var 
  dx, dy, d: Integer; 
begin 
  d := ord(wrong) * Random(TopLeft - 5); 
  with MStar[I] do 
  begin 
    case wich of 
      arTopLeft: 
        begin 
          x := Random(OriginX - d); 
          y := Random(OriginY - d); 
        end; 
      arTopRight: 
        begin 
          x := Random(OriginX + d) + OriginX; 
          y := Random(OriginY - d); 
        end; 
      arBottomLeft: 
        begin 
          x := Random(OriginX - d); 
          y := Random(OriginY + d) + OriginY; 
        end; 
      else 
        begin 
          x := Random(OriginX + d) + OriginX; 
          y := Random(OriginY + d) + OriginY; 
        end; 
      end; 
    stp := Random(6) + 2; 
    case stp of 
      2, 3: 
        cl := $B08080; 
      4, 5: 
        cl := $80EFFF; 
      else 
        cl := clWhite 
    end; 
    dx := x - OriginX; 
    dy := y - OriginY; 
    lg := Sqrt(sqr(dx) + sqr(dy)); 
    angle := ArcTan2(dy, dx); 
    w := wich; 
  end; 
end; 
 
procedure TForm1.Build; 
var 
  I: Integer; 
begin 
  for I := 0 to TopLeft do 
    One(I, arTopLeft); 
  for I := TopLeft + 1 to TopRight do 
    One(I, arTopRight); 
  for I := TopRight + 1 to BottomLeft do 
    One(I, arBottomLeft); 
  for I := BottomLeft + 1 to BottomRight do 
    One(I, arBottomRight); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  cnv := Canvas; // z. B. 
  Rct := Rect(0, 0, Screen.Width, Screen.Height); // z. B. 
  OriginX := (Rct.Right - Rct.Left) div 2; // z. B. 
  OriginY := (Rct.Bottom - Rct.Top) div 2; // z. B. 
  FormStyle := fsStayOnTop; 
  Cursor := crNone; 
  Borderstyle := bsNone; 
  WindowState := wsMaximized; 
  Stars := Round(Sqrt(Rct.Right - Rct.Left) * Sqrt(Rct.Bottom - Rct.Top) / 2); 
  setlength(MStar, Stars); 
  TopLeft := Stars div 4; 
  TopRight := TopLeft * 2; 
  BottomLeft := TopRight + TopLeft; 
  BottomRight := Stars - 1; 
  Color := BackColor; 
  Build; 
  setcursorpos(Screen.Width, Screen.Height); 
  Timer1.interval := 12; // z. B. 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  MStar := nil; 
  setcursorpos(Screen.Width div 2, Screen.Height div 2); 
end; 
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 
begin 
  Close; 
end; 
 
procedure TForm1.FormClick(Sender: TObject); 
begin 
  wrong := not wrong; 
end; 
 
end.