Как сделать крутящиеся шестеренки

uses Graph,Crt;
 
var
  grDriver: Integer;
  grMode  : Integer;
  ErrCode : Integer;
 
procedure DrawGear(X,Y,A: Integer);
Var
  AC1,AC2: ArcCoordsType;
  i: Integer;
begin
 Circle(X, Y, 40);
 for i := 1 to 19
 do begin
    if i mod 2 <> 0
    then begin
         Arc(X, Y, A+i*20+10, A+i*20+30, 110);
         GetArcCoords(AC1);
         if i > 1
         then Line(AC1.XStart, AC1.YStart, AC2.XEnd, AC2.YEnd);
         end
    else begin
         Arc(X, Y, A+i*20+15, A+i*20+25, 140);
         GetArcCoords(AC2);
         Line(AC1.XEnd, AC1.YEnd, AC2.XStart, AC2.YStart);
         end;
    end;
end;
 
procedure AnimateGear;
Var i: Integer;
begin
 i := 0;
 repeat
  SetColor(White);
  DrawGear(200, 200, i*5);
  Delay(80);
  SetColor(Black);
  DrawGear(200, 200, i*5);
  Inc(i);
  if i > 72 then i := 0;
 until keypressed;
end;
 
 
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, '');
  ErrCode := GraphResult;
  if ErrCode = grOk
  then begin
       AnimateGear;
       CloseGraph;
       end
  else begin
       WriteLn('Ошибка инициализации графики:', GraphErrorMsg(ErrCode));
       ReadLn;
       end;
end.

uses Graph,Crt;
 
Type
 TGear = record
  X, Y: Integer;
  R: Integer;
  TC, TH: Integer;
  A: Integer;
  Color: Word;
 end;
 
Const
 GearCount = 2;
var
  grDriver: Integer;
  grMode  : Integer;
  ErrCode : Integer;
  Gears: Array[1..GearCount] of TGear;
 
procedure DrawGear(G: TGear);
Var
  AC1, AC2: ArcCoordsType;
  i: Integer;
  Rad: Integer;
begin
 Circle(G.X, G.Y, G.R shr 1);
 Rad := 360 div (G.TC shl 1);
 for i := 1 to G.TC shl 1 + 1
 do begin
    if i mod 2 <> 0
    then begin
         Arc(G.X, G.Y, i*Rad+G.A, i*Rad+G.A+Rad, G.R);
         GetArcCoords(AC1);
         if i > 1
         then Line(AC1.XStart, AC1.YStart, AC2.XEnd, AC2.YEnd);
         end
    else begin
         Arc(G.X, G.Y, i*Rad+G.A+Rad shr 2, i*Rad+G.A+Rad-Rad shr 2, G.R+G.TH);
         GetArcCoords(AC2);
         Line(AC1.XEnd, AC1.YEnd, AC2.XStart, AC2.YStart);
         end;
    end;
end;
 
procedure AnimateGear(G: TGear; Color: Integer);
begin
 SetColor(Color);
 DrawGear(G);
end;
 
procedure AnimateScene;
Var A, i: Integer;
begin
 A := 0;
 repeat
  for i := 1 to GearCount
  do AnimateGear(Gears[i], Gears[i].Color);
  Delay(40);
  for i := 1 to GearCount
  do begin
     AnimateGear(Gears[i], Black);
     if i mod 2 = 0
     then begin
          Inc(Gears[i].A);
          if Gears[i].A > 360 then Gears[i].A := 0;
          end
     else begin
          Dec(Gears[i].A);
          if Gears[i].A < 0 then Gears[i].A := 360;
          end;
     end;
 until KeyPressed;
end;
 
procedure InitScene;
begin
 Gears[1].X := 200; Gears[1].Y := 200;
 Gears[1].R := 60;
 Gears[1].TC := 6; Gears[1].TH := 30;
 Gears[1].A := 0;
 Gears[1].Color := LightRed;
 
 Gears[2].X := 364; Gears[2].Y := 200;
 Gears[2].R := 60;
 Gears[2].TC := 6; Gears[2].TH := 30;
 Gears[2].A := 50;
 Gears[2].Color := LightBlue;
end;
 
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, '');
  ErrCode := GraphResult;
  if ErrCode = grOk
  then begin
       InitScene;
       AnimateScene;
       CloseGraph;
       end
  else begin
       WriteLn('Ошибка инициализации графики:', GraphErrorMsg(ErrCode));
       ReadLn;
       end;
end.