幻方检验通用程序

（如果你构成了一个幻方，不知道它究竟具有什么性质，那么这个程序将帮助你。）

Sub swcg(n) '幻方检验过程
Erase L
L(0) = n * (n * n + 1) / 2
k = 0: z = 2 * n + 2
For i = 1 To n
For j = 1 To n
L(i) = L(i) + c(i, j) '验算幻方C的行和与列和
L(n + i) = L(n + i) + c(j, i)
Next j
Next i
For j = 1 To n
L(z - 1) = L(z - 1) + c(j, j)
L(z) = L(z) + c(n + 1 - j, j) '验算幻方C的两条对角线
Next j
For i = 1 To z
If L(i) <> L(1) Then '上述结果与幻方C的幻和比较
k = k + 1
End If
Next i
Dim w As Long
gk = 0
For t = 0 To n - 1
w = 0 '验算幻方C的泛主对角线
For j = 1 To n
i = t + j
If i > n Then i = i - n
w = w + c(i, j)
Next j
If w <> L(1) Then gk = gk + 1
Next t
For t = 0 To n - 1
w = 0 '验算幻方C的泛付对角线
For j = 1 To n
i = n + 1 + t - j
If i > n Then i = i - n
w = w + c(i, j)
Next j
If w <> L(1) Then gk = gk + 1
Next t
End Sub

Sub wdwx(n) '优化检验过程
Erase Ms, Mt
t = 1
For i = 1 To n
wk = 0
For j = 1 To n
s = c(i, j) '验算幻方C的行上各项平方和
wk = wk + s * s
Next j
Ms(t) = wk
t = t + 1
Next i
For j = 1 To n
wk = 0
For i = 1 To n
s = c(i, j) '验算幻方C的列上各项平方和
wk = wk + s * s
Next i
Ms(t) = wk
t = t + 1
Next j
For t = 0 To n - 1
wk = 0 '验算幻方C的泛主对角线上的平方和
For j = 1 To n
i = t + j
If i > n Then i = i - n
s = c(i, j)
wk = wk + s * s
Next j
Mt(t + 1) = wk
Next t
For t = 0 To n - 1
wk = 0 '验算幻方C的泛付对角线上的平方和
For j = 1 To n
i = n + 1 + t - j
If i > n Then i = i - n
s = c(i, j)
wk = wk + s * s
Next j
Mt(t + n + 1) = wk
Next t
If n < 33 Then
uuyy n
End If
If n < 12 Then
ymuq n '验算幻方C斜线上的高次幂和
End If
End Sub

Sub uuyy(n)
Erase Mr, Mu
t = 1
For i = 1 To n
wk = 0
For j = 1 To n
sh@ = c(i, j)
sm@ = sh@ * sh@ * sh@ '验算幻方C的行上的立方和
wk = wk + sm@
Next j
Mr(t) = wk
t = t + 1
Next i
For j = 1 To n
wk = 0
For i = 1 To n
sh@ = c(i, j)
sm@ = sh@ * sh@ * sh@ '验算幻方C的列上的立方和
wk = wk + sm@
Next i
Mr(t) = wk
t = t + 1
Next j
For t = 0 To n - 1
wk = 0 '验算幻方C的主斜线上的立方和
For j = 1 To n
i = t + j
If i > n Then i = i - n
sh@ = c(i, j)
sm@ = sh@ * sh@ * sh@
wk = wk + sm@
Next j
Mu(t + 1) = wk
Next t
For t = 0 To n - 1
wk = 0 '验算幻方C的副斜线上的立方和
For j = 1 To n
i = n + 1 + t - j
If i > n Then i = i - n
sh@ = c(i, j)
sm@ = sh@ * sh@ * sh@
wk = wk + sm@
Next j
Mu(t + n + 1) = wk
Next t
End Sub

Private Sub cfwxgy_Click() '平方和检验
If n Mod 2 = 1 Then Exit Sub
Picture2.Print
For t = 0 To a - 1
wu@ = 0: wv@ = 0 '验算幻方C的等距主斜线
For j = 1 To a
i = t + j
If i > a Then i = i - a
su@ = c(i, j): sv@ = c(i + a, j + a) '1,4 区内
wu@ = wu@ + su@ * su@ + sv@ * sv@
sx@ = c(i, j + a): sy@ = c(i + a, j) '2,3 区内
wv@ = wv@ + sx@ * sx@ + sy@ * sy@
Next j
Picture2.Print " "; wu@; " "; wv@
Next t
Picture2.Print
For t = 0 To a - 1
wu@ = 0: wv@ = 0 '验算幻方C的等距付斜线
For j = 1 + a To n
i = n + 1 + t - j
If i > a Then i = i - a
su@ = c(i, j): sv@ = c(i + a, j - a) '2,3 区内
wu@ = wu@ + su@ * su@ + sv@ * sv@
sx@ = c(i, j - a): sy@ = c(i + a, j) '1,4 区内
wv@ = wv@ + sx@ * sx@ + sy@ * sy@
Next j
Picture2.Print " "; wu@; " "; wv@
Next t
End Sub

Private Sub cfwxuy_Click() '立方和检验
If n Mod 2 = 1 Then Exit Sub
Picture2.Print
For t = 0 To a - 1
wu@ = 0: wv@ = 0 '验算幻方C的等距主斜线
For j = 1 To a
i = t + j
If i > a Then i = i - a
su@ = c(i, j): sv@ = c(i + a, j + a) '1,4 区内
wu@ = wu@ + su@ * su@ * su@ + sv@ * sv@ * sv@
sx@ = c(i, j + a): sy@ = c(i + a, j) '2,3 区内
wv@ = wv@ + sx@ * sx@ * sx@ + sy@ * sy@ * sy@
Next j
Picture2.Print " "; wu@; " "; wv@
Next t
Picture2.Print
For t = 0 To a - 1
wu@ = 0: wv@ = 0 '验算幻方C的等距付斜线
For j = 1 + a To n
i = n + 1 + t - j
If i > a Then i = i - a
su@ = c(i, j): sv@ = c(i + a, j - a) '2,3 区内
wu@ = wu@ + su@ * su@ * su@ + sv@ * sv@ * sv@
sx@ = c(i, j - a): sy@ = c(i + a, j) '1,4 区内
wv@ = wv@ + sx@ * sx@ * sx@ + sy@ * sy@ * sy@
Next j
Picture2.Print " "; wu@; " "; wv@
Next t
End Sub

Private Sub cfwxxt_Click() '串联（等距）斜线检验
If n Mod 2 = 1 Then Exit Sub
For t = 0 To a - 1
ws& = 0: wt& = 0 '验算幻方C的等距主斜线
For j = 1 To a
i = t + j
If i > a Then i = i - a
ws& = ws& + c(i, j) + c(i + a, j + a) '1,4 区内
wt& = wt& + c(i, j + a) + c(i + a, j) '2,3 区内
d(i, j) = t + 1: d(i + a, j + a) = t + 1
d(i, j + a) = t + 1 + a: d(i + a, j) = t + 1 + a
'Picture2.Print " "; c(i, j); " "; c(i + a, j + a); _
" "; c(i, j + a); " "; c(i + a, j)
Next j
Picture2.Print " "; ws&; " "; wt&
Next t
For i = 1 To n
For j = 1 To n
Picture2.Print Tab(6 * j); d(i, j);
Next j
Picture2.Print
Next i
For t = 0 To a - 1
ws& = 0: wt& = 0 '验算幻方C的等距付斜线
For j = 1 + a To n
i = n + 1 + t - j
If i > a Then i = i - a
ws& = ws& + c(i, j) + c(i + a, j - a) '2,3 区内
wt& = wt& + c(i, j - a) + c(i + a, j) '1,4 区内
m(i, j) = t + 1: m(i + a, j - a) = t + 1
m(i, j - a) = t + 1 + a: m(i + a, j) = t + 1 + a
'Picture2.Print " "; c(i, j); " "; c(i + a, j - a); _
" "; c(i, j - a); " "; c(i + a, j)
Next j
Picture2.Print " "; ws&; " "; wt&
Next t
For i = 1 To n
For j = 1 To n
Picture2.Print Tab(6 * j); m(i, j);
Next j
Picture2.Print
Next i
End Sub
Private Sub Command2_Click() '分解幻方
Erase d, ea, eb
qk = sk * n + 20
Picture2.Print Tab(30); " 幻方Ｃ分解如下： "
For i = 1 To n
For j = 1 To n
ea(i, j) = (c(i, j) + n - 1) \ n
eb(i, j) = c(i, j) Mod n
If eb(i, j) = 0 Then eb(i, j) = n
Next j
Next i
For i = 1 To n '
For j = 1 To n '显示行标方阵
Picture2.Print Tab(sk * j); ea(i, j);
Next j
For j = 1 To n '显示列标方阵
Picture2.Print Tab(sk * j + qk); eb(i, j);
Next j
Picture2.Print
Next i
For i = 1 To n '用下标拉丁法合成幻方Ｄ
For j = 1 To n
d(i, j) = (ea(i, j) - 1) * n + eb(i, j)
Picture2.Print Tab(5 * j); d(i, j);
Next j
Picture2.Print
Next i
Open "d:\特优幻方佳作.txt" For Append As #1 '打开或创立文件
Print #1,
Print #1, Tab(30); " 幻方Ｃ分解如下： "
For i = 1 To n '
For j = 1 To n '显示行标方阵
Print #1, Tab(sk * j); ; ea(i, j);
Next j
For j = 1 To n '显示列标方阵
Print #1, Tab(sk * j + qk); eb(i, j);
Next j
Print #1,
Next i
Print #1,
Close #1
End Sub

Private Sub Command3_Click() '调试优化幻方
If Mx(r) = 0 Then Exit Sub
Do While (Mx(r) + My(r)) Mod 2 = 1
r = r + 1
Loop
For i = 1 To n
For j = 1 To n
d(i, j) = c(i, j)
Next j
Next i
Erase c
cy = (Mx(r) - My(r)) / 2
cx = 1 - (Mx(r) + My(r)) / 2
For i = 1 To n
For j = 1 To n
x = i + cx: y = j + cy
If x < 1 Then x = x + n
If x > n Then x = x - n '拉回界内！
If y < 1 Then y = y + n
If y > n Then y = y - n '拉回界内！
c(x, y) = d(i, j)
Next j
Next i
Picture2.Print Tab(20); "平移（"; cx; ","; cy; "） 。 "; "r= "; r
Picture2.Print
For i = 1 To n
For j = 1 To n
Picture2.Print Tab(sk * j); c(i, j);
Next j
Picture2.Print
Next i
r = r + 1
End Sub

Private Sub Command4_Click() '退出
End
End Sub

Private Sub Command5_Click() '清屏
Picture2.Cls
HScroll1.Value = 10
VScroll1.Value = 10
End Sub

Private Sub Command6_Click() '记录
Open "d:\特优幻方佳作.txt" For Append As #1 '打开或创立文件
Print #1, wr
Print #1, Tab(20); n; " 阶特优幻方C如下："; "从1 填到 "; n * n
If ck = 1 Then
Print #1, " 这是一个中心对称幻方，"; " 对称两项和为 "; b
ElseIf ck = 2 Then
Print #1, " 这是一个等距对调幻方，"; " 对称两项和为 "; b
End If
Print #1,
For i = 1 To n
For j = 1 To n
pk = IIf(j > a, 6, 0)
Print #1, Tab(sk * j + pk); c(i, j);
Next j
Print #1,
If i = a Then Print #1,
Next i
If k = 0 Then
Print #1, " "; n, "阶幻方，其幻和为"; L(0), _
"C的每一行、每一列及两对角线上数之和都是："; L(1)
If gk = 0 Then Print #1, "好，C是一个"; n; "阶完美幻方！", _
" 离散率为： "; Format$(L(1) / L(0), "#.##")
Else
Print #1, Tab(20); "遗憾，C不是一个幻方！"; "其中有"; k; "条不符合要求。"
End If
Print #1, "幻方C的行、列上诸数之和如下："
For i = 1 To n
Print #1, " "; L(i);
Next i
Print #1,
For i = 1 To n
Print #1, " "; L(n + i);
Next i
Print #1,
Print #1, "幻方C的行上平方和如下："
For i = 1 To n
Print #1, " "; Ms(i);
Next i
Print #1,
Print #1, "幻方C的列上平方和如下："
For i = 1 To n
Print #1, " "; Ms(n + i);
Next i
Print #1,
Print #1, "幻方C的斜线上之平方和如下："
For i = 1 To n
Print #1, " "; Mt(i);
Next i
Print #1,
For i = 1 To n
Print #1, " "; Mt(n + i);
Next i
Print #1,
Print #1, "幻方C的行列上之立方和如下："
For i = 1 To n
Print #1, " "; Mr(i);
Next i
Print #1,
For i = 1 To n
Print #1, " "; Mr(n + i);
Next i
Print #1,
Print #1, "幻方C的斜线上之立方和如下："
For i = 1 To n
Print #1, " "; Mu(i);
Next i
Print #1,
For i = 1 To n
Print #1, " "; Mu(n + i);
Next i
Print #1,
Print #1, "幻方C的两对角线上之平方和、立方和如下："
Print #1, " "; Mt(1); " "; Mt(n + 1); " "; Mu(1); " "; Mu(n + 1)
Print #1,
If n < 12 Then
Print #1,
Print #1, "幻方C的斜线上之四次方和如下："
For i = 1 To n
Print #1, " "; Mv(i);
Next i
Print #1,
For i = 1 To n
Print #1, " "; Mv(n + i);
Next i
Print #1,
Print #1, "幻方C的斜线上之五次方和如下："
For i = 1 To n
Print #1, " "; Mw(i);
Next i
Print #1,
For i = 1 To n
Print #1, " "; Mw(n + i);
Next i
Print #1,
End If
Print #1,
For i = 1 To n
For j = 1 To n
pk = IIf(j > a, 6, 0)
Print #1, Tab(sk * j + pk); d(i, j);
Next j
Print #1,
If i = a Then Print #1,
Next i
Print #1,
For i = 1 To n
For j = 1 To n
pk = IIf(j > a, 6, 0)
Print #1, Tab(sk * j + pk); m(i, j);
Next j
Print #1,
If i = a Then Print #1,
Next i
Close #1
End Sub

Private Sub Command7_Click() '常规检验
swcg n
Picture2.Print
Picture2.Print "幻方C的行、列上诸数之和如下："
For i = 1 To n
Picture2.Print " "; L(i);
Next i
Picture2.Print
For i = 1 To n
Picture2.Print " "; L(n + i);
Next i
Picture2.Print
L(0) = n * (n * n + 1) / 2
If k = 0 Then
Picture2.Print " "; n, "阶幻方，其幻和为"; L(0), "C的每一行、每一列及两对角线上数之和都是："; L(1)
MsgBox "这个C是一个标准幻方。", 48, "检验结论:"
Else
Picture2.Print
Picture2.Print Tab(20); "遗憾，C不是一个幻方！"; "其中有"; k; "条不符合要求。"
Exit Sub
End If
If (k = 0) And (gk = 0) Then
Picture2.Print " 好， C是一个 "; n; "阶完美幻方！", " 离散率为： "; Format$(L(1) / L(0), "#.##")
Else
Picture2.Print Tab(20); "遗憾，C不是一个完美幻方！"; "其中有"; gk; "条不符合要求。"
End If
End Sub

Private Sub Command8_Click() '优化检验
Erase Mx, My, Mz
Call wdwx(n)
Picture2.Print " 以下是幻方行、列上的平方和： "
For i = 1 To n
Picture2.Print " "; Ms(i);
Next i
Picture2.Print
For i = n + 1 To n + n
Picture2.Print " "; Ms(i);
Next i
Picture2.Print
Picture2.Print " 以下是幻方行、列上的立方和： "
For i = 1 To n
Picture2.Print " "; Mr(i);
Next i
Picture2.Print
For i = n + 1 To n + n
Picture2.Print " "; Mr(i);
Next i
Picture2.Print
Picture2.Print
Picture2.Print ; " 以下是幻方主、副泛对角线上的平方和： "
For i = 1 To n
Picture2.Print " "; Mt(i);
Next i
Picture2.Print
For i = n + 1 To n + n
Picture2.Print " "; Mt(i);
Next i
Picture2.Print
Picture2.Print " 以下是幻方主、副泛对角线上的立方和： "
For i = 1 To n
Picture2.Print " "; Mu(i);
Next i
Picture2.Print
For i = n + 1 To n + n
Picture2.Print " "; Mu(i);
Next i
Picture2.Print
Picture2.Print " 以下是幻方主、副对角线上的平方和及立方和"
Picture2.Print " "; Mt(1); " "; Mt(n + 1); " "; Mu(1); " "; Mu(n + 1)
If n < 12 Then
Picture2.Print "幻方C的斜线上之四次方和如下："
For i = 1 To n
Picture2.Print " "; Mv(i);
Next i
Picture2.Print
For i = 1 To n
Picture2.Print " "; Mv(n + i);
Next i
Print
Picture2.Print
Picture2.Print "幻方C的斜线上之五次方和如下："
For i = 1 To n
Picture2.Print " "; Mw(i);
Next i
Picture2.Print
For i = 1 To n
Picture2.Print " "; Mw(n + i);
Next i
Picture2.Print
End If
End Sub

Private Sub Form_Load()
ak = 0: bk = 1
Picture2.AutoSize = True
Picture1.BorderStyle = 0
Picture2.BorderStyle = 0
HScroll1.Max = Picture2.Width - Picture1.Width
VScroll1.Max = Picture2.Height - Picture1.Height
End Sub

Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub