unit Unit4;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  N = 14;
  rij : array[0..N] of integer = { Star positions }
  (  0, 30, 60, 90,120,135,150,165,180,210,240,270,300,330,360);
  hel : array[0..N] of integer = { Star luminosity }
  ( 10, 14, 18, 22, 26, 28, 30, 28, 26, 22, 18, 14, 10,  6, 10);
  {  0, 30, 60, 90,120,135,150,165,180,210,240,270,300,330,360}
var
  alpha,sigma : double;
  loop : integer;
  titel : string;

function Grijs(getal : double) : TColor;
{
  Translates Real into Grey values
}
var
  even,k : byte;
  effe : Tcolor;
begin
  if getal < 0 then getal := 0;
  if getal > 1 then getal := 1;
  effe := 0;
  for k := 1 to 3 do
  begin
    even := Round(255*(1-getal));
    effe := (effe shl 8) or even;
  end;
  Grijs := $00000000 or effe;
end;

procedure ClearDevice(scherm : TImage);
{
  Clear Screen
}
var
  W,H : integer;
  rechthoek : TRect;
begin
  W := scherm.Width;
  H := scherm.Height;
  rechthoek := Rect(0,0,W,H);
  with scherm.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(rechthoek);
  end;
end;

procedure berekenen(var W,H : integer; var a,b,R : double);
begin
  W := Form1.Image1.Width-1; H := Form1.Image1.Height-1;
  a := W/2; b := H/2; if W > H then R := H/4 else R := W/4;
end;

procedure tekenen;
{
  The stars
}
var
  W,H,k,i,j : integer;
  a,b,R,hoek : double;
begin
  berekenen(W,H,a,b,R);
  for k := 0 to N-1 do
  begin
    with Form1.Image1.Canvas do
    begin
      Brush.Color := Grijs(hel[k]/30);
      Pen.Color := Grijs(hel[k]/30);
      hoek := rij[k]*Pi/180;
      i := Round(a + R*cos(hoek));
      j := Round(b + R*sin(hoek));
      Ellipse(i-5,j-5,i+5,j+5);
    end;
  end;
  Form1.Image1.Canvas.Pen.Color := clBlack;
end;

procedure discreet;
{
  The blurring
}
var
  W,H,i,j,k,ib,ie,jb,je : integer;
  a,b,R,max,t,x,y,arg,xx,yy : double;
  beeld : array of array of double;
  niet : boolean;
begin
  Form1.Caption := titel + ': discretized';
  berekenen(W,H,a,b,R);
  SetLength(beeld,W+1,H+1);
  for i := 0 to W do for j := 0 to H do beeld[i,j] := 0;
  max := 0;
  for k := 0 to N-1 do
  begin
    t := rij[k]*Pi/180; x := a + R*cos(t); y := b + R*sin(t);
    ib := Round(x - alpha*sigma); ie := Round(x + alpha*sigma);
    jb := Round(y - alpha*sigma); je := Round(y + alpha*sigma);
    for j := jb to je do
    begin
      niet := (j < 0 ) or (j > H); 
      if niet then Continue; y := j;
      yy := sqr(y-b-R*sin(t));
      for i := ib to ie do
      begin
        niet := (i < 0) or (i > W);
        if niet then Continue; x := i;
        xx := sqr(x-a-R*cos(t));
        arg := (xx + yy)/sqr(sigma);
        beeld[i,j] := beeld[i,j] + hel[k]*exp(-arg/2);
        if beeld[i,j] > max then max := beeld[i,j];
      end;
    end;
  end;
  for i := 0 to W-1 do
  for j := 0 to H-1 do
     Form1.Image1.Canvas.Pixels[i,j] := Grijs(beeld[i,j]/max);
end;

procedure starten;
begin
  alpha := sqrt(2*ln(512));
  loop := 0;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var 
  W,H,k : integer;
  a,b,R,dt,hoek : double;
begin
  berekenen(W,H,a,b,R);
  hoek := 0;
  for k := 0 to N-1 do
  begin
    dt := (rij[k+1]-rij[k])*Pi/180;
    if dt > hoek then hoek := dt;
  end;
  sigma := 2*R*sin(hoek/2)/(2*Pi)*alpha*1.5;
  Screen.Cursor := crHourGlass;
  ClearDevice(Form1.Image1);
  case (loop mod 2) of
  0 : tekenen; { Sterren }
  1 : discreet; { vervaagd }
  end;
  loop := loop + 1;
  Screen.Cursor := crDefault;
  Form1.Image1.Picture.SaveToFile('hdb'+char(loop+48)+'.bmp');
{ Van de plaatjes worden vervolgens negatieven gemaakt en
  ze worden geschaald op 30-33 % om te kunnen combineren. } 
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  starten;
  Writeln('alpha = ',alpha);
  titel := Form1.Caption;
end;

end.