画出太极图
今天在网上看到有网友发出了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