Моделирование лунного затмения (Delphi)

[NamelessEndless]

Нужно смоделировать лунное затмение. Интересует такое:
Есть рисунок (см.ниже), зеленый круг (Земля), синее коло (хз что) – статические.
К Земле будет ползти Луна. Когда луна (серый круг) будет находиться
В области земли, нужно изменить ее цвет на красный.
Как сделать проверку принадлежности круга Луны кругу Земли?
Центр Земли - точка с координатами х 500, у 250

[Скандербег]

Для такой проверки надо воспользоваться API функциями.

function TForm1.Regions: Boolean;
var
  Rg1, Rg2 : HRGN;
  I : Integer;
begin
  Rg1 := CreateEllipticRgn(Shape1.BoundsRect.Left, Shape1.BoundsRect.Top,
                           Shape1.BoundsRect.Right, Shape1.BoundsRect.Bottom);
  Rg2 := CreateEllipticRgn(Shape2.BoundsRect.Left, Shape2.BoundsRect.Top,
                           Shape2.BoundsRect.Right, Shape2.BoundsRect.Bottom);
  I := CombineRgn(Rg1, Rg1, Rg2, RGN_AND);
  Result := I <> NULLREGION;
  DeleteObject(Rg1);
  DeleteObject(Rg2);
end;

Здесь для примера взяты два компонента TShape в виде кругов.

[NamelessEndless]

Скандербег, спасибо. Я тут подумала и решила пойти обходными путями.


Возник еще вопрос...
Как сделать масштабирование всей этой картинки, что есть на канве?
Допустим при нажатии на кнопки + и -.
И еще. Луна (серый круг) появляется как анимация при помощи sleep;
Можно ли сделать паузу в движении и потом возобновить его с того-же места в таком случае?

Ниже коды unit1 , unit2;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button8: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Moon: TMoon;

implementation

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);
var sx1,sx2,sy1,sy2, earthx1, earthx2,earthy1,earthy2, x,y,xx,yy: integer;
xstars, ystars: array [1..3000] of integer;
k : integer;
begin
 sx1:=150;
 sx2:=900;
 sy1:=50;
 sy2:=500;
 earthx1:=450;
 earthx2:=550;
 earthy1:=200;
 earthy2:=300;
 x:=350;
 xx:=650;
 y:=100;
 yy:=400;
 for k:=1 to 3000 do
  begin
    xstars[k]:=random (sx2-sx1);
    ystars[k]:=random (sy1-sy2);
  end;

  With Canvas do begin
    pen.Width:=2;
    pen.color:=ClGreen;
    brush.color:=ClBlack;
    Rectangle(sx1,sy1,sx2,sy2); // малюєм "небо"
    for k:=1 to 3000 do
      Pixels[xstars[k],ystars[k]]:=clwhite;
    pen.Width:=3;
    pen.color:=ClBlue;
    brush.color:=clblack	;
    Ellipse(x,y,xx,yy);    // малюєм ше якусь фігню
    pen.Width:=1;
    pen.color:=claqua;
    brush.color:=clgreen;
    Ellipse(earthx1,earthy1,earthx2,earthy2);  // малюєм Землю
    TextOut(470,305,'Earth umbra');
    brush.color:=ClBlue;
    TextOut(465,407,'Earth penumbra');
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var dx, dy: integer;
i: integer;
begin
FormPaint(nil);
dx:=50;
dy:=50;
for i:=1 to 13 do begin
sleep(200);
Moon.Draw(Form1.Canvas, dx, dy, 100, 204, 2);
dx:=dx+25;
dy:=dy+25;
end;
end;


// закриття програми
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;

// вивід підказки
procedure TForm1.Button2Click(Sender: TObject);
begin
  Label2.Caption:='Під час затемнення (навіть повного) Місяць не зникає
 повністю, а стає темно-червоним.Цей факт пояснюється тим, що Місяць
 навіть у фазі повного затемнення продовжує бути освітлюваним. ';
end;

end.

unit Unit2;

interface
uses Graphics,Forms;

type
  TMoon = class // class lynu
  x1,x2,y1,y2: integer;

  constructor Create (a,b,c,d: integer);
  procedure Draw (Canvas:Tcanvas; dx, dy: integer; r,g,b:byte);

  end;

implementation

constructor TMoon.Create(a,b,c,d:integer);
  begin
    x1:=a;
    y1:=b;
    x2:=c;
    y2:=d;
  end;

    function RGBtoColor(R,G,B:byte):TColor;
  var newcol: byte;
  begin
    newcol:=B shl 16 or G shl 8 or R;
  end;
// rusovanie lynu
  procedure TMoon.Draw(Canvas:TCanvas; dx, dy: integer; r,g,b:byte);
  var x1,x2,y1,y2: integer;
  dx1, dy1: integer;
  col1, r1,b1,g1: byte;
    begin
      dx1:=dx; dy1:=dy;
      x1:=700;
      x2:=730;
      y1:=450;
      y2:=480;
      r1:=r; g1:=g; b1:=b;
      col1:=RGBtoColor(r1,g1,b1);
      with canvas do begin
        pen.Width:=1;
        pen.color:=clwhite;
        brush.color:=clsilver;
        Ellipse(x1-dx1,y1-dy1,x2-dx1,y2-dy1);
        TextOut(715, 425, 'Moon');
      end;
    end;

end.

[Скандербег]

По второму вопросу.
Через таймер (закладка "System").
Предварительные установки:
Enabled = False
Interval = 200;
OnTimer = Timer1Timer

...
var
  dx : Integer = 50;
  dy : integer = 50;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled := not Timer1.Enabled;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Moon.Draw(Form1.Canvas, dx, dy, 100, 204, 2);
  dx:=dx+25;
  dy:=dy+25;
  if dx = 13*25+50 then begin
    Timer1.Enabled := false;
  end;
end;

При нажатии на кнопку Button1 начинается анимация. При повторном нажатии - останавливается.

В проекте, как в нем сделана прорисовка, масштабирование реализовать не так просто.

И вообще, всю эту анимацию можно сделать намного проще.

[NamelessEndless]

Скандербег, еще раз спасибо (жала весы, надеюсь, все додало)))

Да, анимацию может и можно сделать проще, но главное что мне мешает - недостаточный багаж собственных знаний. А когда строки поджимают, впихивать что-то новое все сложнее.

Тем более, по крайней мере с такой анимацией я худо-бедно понимаю, как сделать, чтобы на каждый шаг Луна изменяла свой цвет. Там еще это нужно будет сделать. Уже пробовала, но функция, которая переводит ргб в тколор что-то не то делала) Прорвусь.)

[Скандербег]

RGB нормальная функция. Можно применить такой прием. На форму кинуть ColorDialog (ColorGrid в этом случае бесполезен). Особенность его в том, что работает и в design-time.
При двойном щелчке он открывает свой диалог, где кнопка "Определить цвет" открывает, в свою очередь, всю палитру. и в ней уже прекрасно видно какие значения цветовых составляющих должны быть переданы как параметры в RGB.
Остается только не перепутать порядок параметров в вызове функции.