Есть ошибки

[Lisёноk]

Здравствуйте! Попыталась написать программу. По аналогии с циклом к первой кнопке, попыталась написать второй.
Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


var
R1, R2 : TRect;

procedure Ellipse1;
var i : integer;
begin
for i := 1 to 20 do
begin
Form1.image1.Canvas.Pen.Color := clMaroon;
Form1.image1.Canvas.Arc(R1.Left, R1.Top, R1.Right, R1.Bottom, R1.Left, R1.Top, R1.Left, R1.Top);
InflateRect(R1, -1, 1);

Form1.image1.Canvas.Pen.Color := clWhite;
Form1.image1.Canvas.Arc(R2.Left, R2.Top, R2.Right, R2.Bottom, R2.Left, R2.Top, R2.Left, R2.Top);
InflateRect(R2, 1, -1);

Application.ProcessMessages;
sleep (100);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
begin
Form1.DoubleBuffered:=TRUE;
WITH Image1.Canvas DO BEGIN
Brush.Color:=clMedGray;
Pen.Color:=clMaroon;
Pen.Style:=psSolid;
Pen.Width:=2;
Font.Size:=20;
Font.Style:= [fsItalic, fsBold];
Brush.Style:=bsClear;
Font.Color:=clBlue;
TextOut (430, 300, 'Маяк');
FillRect(Image1.ClientRect);
MoveTo(Image1.Width DIV 3 - 40,Image1.Height DIV 3 + 40);
LineTo(Image1.Width DIV 2 ,Image1.Height DIV 3 - 40);
Brush.Color:=clSilver;

R1 := Rect(Image1.Width DIV 4 + 45, Image1.Height DIV 3 - 45,
               Image1.Width DIV 4 - 45, Image1.Height DIV 3 + 45);
R2 := Rect(Image1.Width DIV 2 + 45, Image1.Height DIV 3 - 45,
               Image1.Width DIV 2 - 45, Image1.Height DIV 3 + 45);
Ellipse(R1);

Brush.Color := clMaroon;
InflateRect(R2, -20, 20);
Ellipse(R2);

Brush.Color := clMedGray;
InflateRect(R2, 20, -20);
Ellipse(R2);
InflateRect(R2, -20, 20);

Ellipse1;
end;
end;


procedure Ellipse2;
var i : integer;
begin
for i := 1 to 20 do
begin
Form1.image1.Canvas.Pen.Color := clWhite;
Form1.image1.Canvas.Arc(R1.Left, R1.Top, R1.Right, R1.Bottom, R1.Left, R1.Top, R1.Left, R1.Top);
InflateRect(R1, 1, -1);

Form1.image1.Canvas.Pen.Color := clMaroon;
Form1.image1.Canvas.Arc(R2.Left, R2.Top, R2.Right, R2.Bottom, R2.Left, R2.Top, R2.Left, R2.Top);
InflateRect(R2, -1, 1);

Application.ProcessMessages;
sleep (100);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i : integer;
begin
Form1.DoubleBuffered:=TRUE;
WITH Image1.Canvas DO BEGIN
Brush.Color:=clMedGray;
Pen.Color:=clMaroon;
Pen.Style:=psSolid;
Pen.Width:=2;
Font.Size:=20;
Font.Style:= [fsItalic, fsBold];
Brush.Style:=bsClear;
Font.Color:=clBlue;
TextOut (430, 300, 'Маяк');
FillRect(Image1.ClientRect);
MoveTo(Image1.Width DIV 3 - 40,Image1.Height DIV 3 + 40);
LineTo(Image1.Width DIV 2 ,Image1.Height DIV 3 - 40);
Brush.Color:=clSilver;

R1 := Rect(Image1.Width DIV 4 + 65, Image1.Height DIV 3 - 65,
               Image1.Width DIV 4 - 65, Image1.Height DIV 3 + 65);
R2 := Rect(Image1.Width DIV 2 + 45, Image1.Height DIV 3 - 45,
               Image1.Width DIV 2 - 45, Image1.Height DIV 3 + 45);
Ellipse(R2);

Brush.Color := clMaroon;
InflateRect(R1, 5, -5);
Ellipse(R1);

Brush.Color := clMedGray;
InflateRect(R1, -3, 3);
Ellipse(R1);
InflateRect(R1, 3, -3);

Ellipse2;
end;
end;
end.

Но цикл от второй кнопке отличается от первой. есть ошибки в отображении. Как их исправить, подскажите пожалуйста. Я вроде понимаю, а сделать не могу.

[Stilet]

А что программа т должна выполнять?
По-моему тут лишнего слишком много

[Lisёноk]

Программа должна показывать как нить наматывается на бобину в обе стороны. И у меня намотка в одну сторону, не совпадает с намоткой в другую.(((
Поэтому преподаватель не хочет ее принимать. То есть в целом ее программа устраивает, но ее не нравится, что намотка ниток отличается. А что подстроить надо я не могу понять(((( Уже вроде все перебрала...