用Visual Basic程式來畫 太極圖

太極圖可看成六塊:
各2組陰陽半圓和一組陰陽圓形



程式如下：

Private Sub form_activate()
Const PI = 3.1415926
Dim bangle, eangle As Single
FillStyle = 0

FillColor = vbBlack
bangle = 90 * PI / 180
eangle = 270 * PI / 180
Circle (3000, 2500), 2000, vbBlack, -bangle, -eangle

bangle = 270 * PI / 180
eangle = 90 * PI / 180
FillColor = vbWhite
Circle (3000, 2500), 2000, vbWhite, -bangle, -eangle

FillColor = vbWhite
bangle = 90 * PI / 180
eangle = 270 * PI / 180
Circle (3000, 3500), 1000, vbWhite, -bangle, -eangle

bangle = 270 * PI / 180
eangle = 90 * PI / 180
FillColor = vbBlack
Circle (3000, 1500), 1000, vbBlack, -bangle, -eangle

FillColor = vbBlack
Circle (3000, 3500), 500, vbBlack

FillColor = vbWhite
Circle (3000, 1500), 500, vbWhite

End Sub

Dear All:

我作了些修改,只要不斷地接著Enter鍵不放,
即可看到您從未發現的太極變化,
動態圖中,除了魚眼不變之外,其他都在變....
'--------------------------------------------
Const PI = 3.1415926

Private Sub form_activate()
Dim bangle, eangle As Single
Dim bangle1, eangle1 As Single

bangle1 = 90
eangle1 = 90

For i = 90 To 450

bangle1 = i
eangle1 = i

FillStyle = 0

FillColor = vbBlack
bangle = bangle1 * PI / 180
eangle = (eangle1 + 180) * PI / 180

bangle = ((bangle / 2 / PI) - Int(bangle / 2 / PI)) * 2 * PI
eangle = ((eangle / 2 / PI) - Int(eangle / 2 / PI)) * 2 * PI

Circle (3000, 2500), 2000, vbBlack, -bangle, -eangle

bangle = (bangle1 + 180) * PI / 180
eangle = eangle1 * PI / 180
FillColor = vbWhite
bangle = ((bangle / 2 / PI) - Int(bangle / 2 / PI)) * 2 * PI
eangle = ((eangle / 2 / PI) - Int(eangle / 2 / PI)) * 2 * PI
Circle (3000, 2500), 2000, vbWhite, -bangle, -eangle

FillColor = vbWhite
bangle = bangle1 * PI / 180
eangle = (eangle1 + 180) * PI / 180
bangle = ((bangle / 2 / PI) - Int(bangle / 2 / PI)) * 2 * PI
eangle = ((eangle / 2 / PI) - Int(eangle / 2 / PI)) * 2 * PI
Circle (3000, 3500), 1000, vbWhite, -bangle, -eangle

bangle = (bangle1 + 180) * PI / 180
eangle = bangle1 * PI / 180
FillColor = vbBlack
bangle = ((bangle / 2 / PI) - Int(bangle / 2 / PI)) * 2 * PI
eangle = ((eangle / 2 / PI) - Int(eangle / 2 / PI)) * 2 * PI
Circle (3000, 1500), 1000, vbBlack, -bangle, -eangle

FillColor = vbBlack
Circle (3000, 3500), 500, vbBlack

FillColor = vbWhite
Circle (3000, 1500), 500, vbWhite

MsgBox ("Press Me !!")

Cls

Next i

End Sub

'修改了一下程式,使用了一些拙劣的技巧終於讓它旋轉成功了

Private Sub Command2_Click()
Const PI = 3.1415926
Dim bangle, eangle As Single
Dim secX, secY As Single
Dim secangle As Single

For i = 90 To 450

For j = 1 To 1000000: Next j


FillStyle = 0 '設定繪圖屬性為填滿

bangle = i * PI / 180
If i > 360 Then bangle = (i - 360) * PI / 180

eangle = (180 + i) * PI / 180
If (180 + i) > 360 Then eangle = (180 + i - 360) * PI / 180

FillColor = vbBlack '黑色大半圓
Circle (3000, 2500), 2000, vbBlack, -bangle, -eangle

bangle = (180 + i) * PI / 180
If (180 + i) > 360 Then bangle = (180 + i - 360) * PI / 180

eangle = i * PI / 180
If i > 360 Then eangle = (i - 360) * PI / 180

FillColor = vbWhite '白色大半圓
Circle (3000, 2500), 2000, vbWhite, -bangle, -eangle

secangle = 2 * PI * ((180 - i) / 360)
secX = Cos(secangle) * 1000
secY = Sin(secangle) * 1000

bangle = i * PI / 180
If i > 360 Then bangle = (i - 360) * PI / 180

eangle = (180 + i) * PI / 180
If (180 + i) > 360 Then eangle = (180 + i - 360) * PI / 180

FillColor = vbWhite '白色小半圓
Circle (3000 + secX, 2500 + secY), 1000, vbWhite ', -bangle, -eangle
FillColor = vbBlack '黑色魚眼
Circle (3000 + secX, 2500 + secY), 500, vbBlack


secangle = 2 * PI * ((360 - i) / 360)
secX = Cos(secangle) * 1000
secY = Sin(secangle) * 1000

bangle = (180 + i) * PI / 180
If (180 + i) > 360 Then bangle = (180 + i - 360) * PI / 180

eangle = i * PI / 180
If i > 360 Then eangle = (i - 360) * PI / 180

FillColor = vbBlack '黑色小半圓
Circle (3000 + secX, 2500 + secY), 1000, vbBlack ', -bangle, -eangle
FillColor = vbWhite '白色魚眼
Circle (3000 + secX, 2500 + secY), 500, vbWhite

Next i

End Sub

將修改後的程式碼放在附件裡面

這支程式碼範例也公佈在網站
http://www.planet-source-code.com/

輸入 TaiChie 關鍵字在Visual Basic分類就可以找得到

往後將會致力於易經占卜程式的國際化原碼製作,
這種東西說什麼也不能讓老外比下去啦!