unit U_DrawMoon;

interface

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

type
  TForm1 = class(TForm)
    PBox: TPaintBox;
    CloseBtn: TButton;
    MoonBtn: TButton;
    procedure FormActivate(Sender: TObject);
    procedure PBoxPaint(Sender: TObject);
    procedure CloseBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MoonBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    moonphase:single; {fraction of moon visible:  0 to 1}
    runflag:boolean; {controls program stopping}
    waxing:boolean;  {true ==> moon visibility is increasing}
    b:TBitmap;       {moon image}
    showmoon:boolean; {flag}

    {moon image coordinates}
    lx,rx,ty,by:integer; {corners of moon image}
    cx,cy:integer; {center of moon image}
    rad:integer; {radius}
  end;

var
  Form1: TForm1;

implementation
uses math;

{$R *.DFM}

{******************* FormActivate ****************}
procedure TForm1.FormActivate(Sender: TObject);
var
  inc:single; {angle - radian increment for each view}
  angle:single;  {the angle of sun}
  fname:string;
  i,j:integer;
begin
  with pbox do
  begin {set moon image dimensions}
    lx:=3;  {left x}
    ty:=2;  {top y}
    rx:=width-lx; {right x}
    by:=height-ty;{bottom y}
    cx:=width div 2; {center}
    cy:=height div 2;
    rad:= cx-lx;{radius}
  end;
  showmoon:=false; {no moon image initially}
  fname:=extractfilepath(application.exename)+'BrightFullMoon.bmp';
  if fileexists(fname) then
  begin
    b:=TBitMap.create;
    b.loadfromfile(fname);
    {b.pixelformat:=pf24bit;} {to force true black background}
    moonbtn.visible:=true; {OK to show the button}
    {trim image to circle}
    for i:=0 to b.width-1 do
    for j:= 0 to b.height-1 do
    if trunc(sqrt((cx-i)*(cx-i)+(cy-j)*(cy-j)))>=rad
    then b.canvas.pixels[i,j]:=clblack;
  end;
  doublebuffered:=true;
  runflag:=true;
  angle:=0;
  inc:=pi/64;
  {loop to set moon phase info}
  repeat
    angle:=angle+inc;
    if angle>=2*pi then angle:=angle-2*pi;
    moonphase:=(1+cos(angle))/2;
    if angle>=Pi then waxing:=true
    else waxing:=false;
    pbox.invalidate; {force redraw}
    application.processmessages;
    sleep(50);
  until runflag=false;
  b.free;
end;

  procedure swap(var a,b:integer);
  {exchange 2 integers}
    var n:integer;
    begin  n:=a; a:=b; b:=n; end;

{****************** PBoxPaint *****************}
procedure TForm1.PBoxPaint(Sender: TObject);
var
  delta:integer; {x distance from center edge of image to center edge of arc}
  fillfrom:integer;  {x coordinate for floodfill}
  ds,de:integer;  {y coord start and end points for arc}
  myblack:integer;
begin
  with PBox,canvas do
  begin
    {make the radius of the crescent vary from "rad" down to 0 as moonphase
     varies from 0 to 1/2 and then back to "rad" as phase goes to 1}
    delta:=trunc(rad*2*abs(moonphase-0.5));
    if showmoon then
    begin
      draw(0,0,b); {draw moon image}
      brush.style:=bsClear; {let ellipse draw only the border}
      myblack:=b.canvas.pixels[1,1];
    end
    else
    begin
      myblack:=clblack;
      brush.color:=myblack;
      rectangle(0,0,width,height);
      brush.color:=$C0E0E0; {B-G-R value $C0E0E0 = light GOLD}
    end;
    pen.color:=myblack;
    ellipse(Lx,TY,RX,By);
    ds:=ty-1;  {set arc start and end points}
    de:=by+1;
    if waxing then {increasing moon}
    begin
      {x coordinate for floodfill to black-out left side for waxing moon}
      fillfrom:=lx+2;
      {arc draws counter-clockwise, so to draw right half of ellipse, start at bottom}
      if moonphase<0.5 then swap(ds,de);

    end
    else {waning (decreasing) moon}
    begin
      fillfrom:=rx-2; {set right side point for floodfill}
      {same thing - waning moon with over 50% showing, draw right portion of ellipse}
      if moonphase>0.5 then swap(ds,de)
    end;
    if delta>1
    then arc(cx-delta,ty,cx+delta,BY,cx,ds,cx,de)
    else {ellipse too narrow to draw, use a line}
    begin
     moveto(cx,ty);
     lineto(cx,by);
    end;
    brush.color:=myblack;
    If moonphase<0.99 then floodfill(fillfrom,cy,myblack,fsborder);
    {pixels[fillfrom,cy]:=cllime;} {for debugging}
  end;
end;
{********************* CloseBtnClick *************}
procedure TForm1.CloseBtnClick(Sender: TObject);
begin
  close;
end;

{******************* FormClose *****************}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  runflag:=false;
  action:=cafree;
end;

{*********************** MoonBtnClick *************}
procedure TForm1.MoonBtnClick(Sender: TObject);
{Set/reset flag to show moon image}
begin
  if not showmoon then
  begin
    showmoon:=true;
    moonbtn.caption:='Hide moon image';
  end
  else
  begin
    showmoon:=false;
    moonbtn.caption:='Show moon image';
  end;
end;

end.