[xchgeaxeax]

Не знаю где там 4 цикла. Можно обойтись и одном, чтобы меньше считать одинаковых значений.

Код:

procedure TForm1.FormPaint(Sender: TObject);
var
  BMP: TBitmap;
  Center, DeltaXY, ArcPos: TPoint;
  Delta, i, k, Min, Max: LongInt;
begin
  BMP := TBitmap.Create;
  BMP.Width  := ClientWidth;
  BMP.Height := ClientHeight;
  Center.x := BMP.Width  shr 1;
  Center.y := BMP.Height shr 1;
  if Center.x <  Center.y then Min := Center.x else Min := Center.y;
  if Center.x >= Center.y then Max := Center.x else Max := Center.y;
  Delta := (Max - Min) shr 1;
  if Delta = 0 then begin
    DeltaXY.x := 1;
    DeltaXY.y := 1;
  end else begin
    DeltaXY.x := Center.x div Delta;
    DeltaXY.y := Center.y div Delta;
  end;
  BMP.Canvas.Brush.Color := Canvas.Brush.Color;
  BMP.Canvas.FillRect(ClientRect);
  with BMP.Canvas do for i := Min div 3 downto 1 do begin
    k := Delta - 3 * Delta * i div Min;
    ArcPos.x := 3 * i * DeltaXY.x shr 3;
    ArcPos.y := 3 * i * DeltaXY.y shr 3;
    Arc(Center.x - k - ArcPos.x, Center.y - k - ArcPos.y, Center.x + k - ArcPos.x, Center.y + k - ArcPos.y, 0, 5760);
    Arc(Center.x - k - ArcPos.x, Center.y - k + ArcPos.y, Center.x + k - ArcPos.x, Center.y + k + ArcPos.y, 0, 5760);
    Arc(Center.x - k + ArcPos.x, Center.y - k - ArcPos.y, Center.x + k + ArcPos.x, Center.y + k - ArcPos.y, 0, 5760);
    Arc(Center.x - k + ArcPos.x, Center.y - k + ArcPos.y, Center.x + k + ArcPos.x, Center.y + k + ArcPos.y, 0, 5760);
  end;
  BMP.Canvas.Arc(Center.x - Delta, Center.y - Delta, Center.x + Delta, Center.y + Delta, 0, 5760);
  Canvas.Draw(0, 0, BMP);
  FreeAndNil(BMP);
end;