画出太极图

今天在网上看到有网友发出了C++的生成太极图算法，兴起之下用Delphi抄了下，效果还可以。

参考地址：http://www.cnblogs.com/WhyEngine/p/4051149.html

先上代码：

procedure TForm1.Button1Click(Sender: TObject);
var
  Cs: TCanvas;
  s: Double;
  i, j, aoffset, r: Cardinal;
begin
  cs := Canvas;
  cs.Brush.Color := clGray;
  cs.FillRect(cs.ClipRect);
  aoffset := 34;
  r := StrToIntDef(edit1.Text, 96);
  s := StrToFloatDef(edit2.Text, 0.2);
  for I := 0 to ClientWidth - aoffset * 2 do
    for j := 0 to ClientHeight - aoffset * 2 do
      CalculatePixel(Cs, i, j, aoffset, r, s)
end;

// r 为太极图的半径，s 为中间两个小圆的缩放比例
procedure TForm1.CalculatePixel(cs: TCanvas; x, y, offset: Cardinal; r, s: Extended);

  procedure SetColor(color: TColor);
  begin
    cs.Pixels[x+offset, y+offset] := color;
  end;

var
  r1, r2, rr: Extended;
  i, j, t, tt: Extended;
begin
  r1 := r;
  r2 := r1 * s;
  rr := r1 * r1;

  i := r - x;
  j := r - y;

  if (i * i + j * j) > rr then
    Exit;

  t := j + r1 * 0.5;
  tt := t * t + i * i;
  if tt < r2 * r2 then begin
    SetColor(clWhite);
    Exit;
  end else if tt < rr * 0.25 then begin
    SetColor(clBlack);
    Exit;
  end;

  t := j - r1 * 0.5;
  tt := t * t + i * i;
  if tt < r2 * r2 then begin
    SetColor(clBlack);
    Exit;
  end else if tt < rr * 0.25 then begin
    SetColor(clWhite);
    Exit;
  end;

  if i < 0.0 then
    SetColor(clWhite)
  else
    SetColor(clBlack);
end;

效果图如下：

http://www.cnblogs.com/yangyxd/articles/4056603.html