幻方套着幻方，你心联着我心

幻方套着幻方，你心联着我心      ————任意阶幻方串程序宣告完成仰光金塔的地影里，就像我们的幻方串，一层又一层，铭刻在我们的心中。在这迷人数字的针叶林里，有一座楼，当听到悦耳的芦笛，我们开始登楼了，在荒砾巨大的数字石块上，刻下了我们写的一首首幻方诗歌；坐在高楼的木椅上，打开一套幻方构造程序，我们能够自由地获得各阶幻方，自由选择调换中心的幻方，我们能自由地让楼层逐渐加高。

延安高治源老师在2023年2月20日24点之前，成功编成任意阶幻方的第四套Vb演算程序。本程序解决的都是各类幻方串的构造问题，其它书上又叫这种幻方为镶砌幻方或者加框幻方，加框、镶砌都是一次性动作，而我们这里的幻方是作任意性的扩展。本程序的幻方构造理论方法在高治源《奇妙的幻方》一书中有详细说明。这样人们只要输入两个幻方的阶数就可以在电子表格中获得任何阶幻方串。这是幻方历史上第一套能够完成所有阶数的幻方串软件。由于构造方法的不同，我们的幻方串分为偶数阶和奇数阶两大类分别构造的。   构造中心的奇数阶幻方和偶数阶幻方，采用了我们编写的第二套任意阶幻方构造程序（两类公式版）。
幻方串的各层扩展，十分精妙简单，但我们感受过程却很陶醉，因为它简洁有趣，可无限扩展。a = (m - s) / 2 可计算扩展层数，不断扩展就靠这样简单的语言：For n = 1 To a，当m-2阶幻方复制到中心后，通过阶数增加公式：m = s + 2 * n，就不断向高层延伸而去。 同样，我们给幻方串染色了，这样才能有一种美妙的楼层式的秩序美。最让我们感到有意思的染色代码是：For k = 1 To aFor j = 1 To m - 2 * k + 2Union(Cells(k - 1 + j + 3, m - k + 4), Cells(k + 3, j + k - 1 + 3), Cells(j + k - 1 + 3, k + 3), Cells(m - k + 4, j + k - 1 + 3)).Select myColor = k Mod 15 + 2With Selection.Interior.ColorIndex = myColor.Pattern = xlSolidEnd With我们思考学习了太久，终于搞成很不容易，所以写在这里。 本程序有所损坏需要联系作者修补，或者想进一步开发程序，可与高治源老师联系，微信号 ：dsdqh1012，昵称：大山的情怀，QQ邮箱：920437101@qq.com 下面，我们将vb程序分享给大家，希望大家提出一些改进程序的建议。
 Sub 任意阶幻方()n = Cells(2, 2)s = Cells(3, 2) If n Mod 2 = 1 Then 构造奇数阶幻方串 If n Mod 2 = 0 Then 偶阶幻方串构造程序 Cells(2, 5) = ' 恭喜你构造成功' + Str(n) + '阶幻方' + ' 中心方阵是' + Str(s) + '阶幻方'End SubSub 构造奇数阶幻方串()Dim c(1000, 1000) '数组p可以装入1000*1000个数Dim i, j, x, y As Integerm = Cells(2, 2) '幻方最大的阶数s = Cells(3, 2) '中心幻方的阶数'构造一个中心幻方For j = 1 To sFor i = 1 To sb = (i - 1 + (s + 1) / 2) Mod s + 1c(j, i) = ((j + s - b) Mod s) * s + (j + b - 2) Mod s + 1Next iNext ja = (m - s) / 2 '计算扩展层数 For n = 1 To a '将m-2阶幻方复制到中心 m = s + 2 * n   For j = 2 To m - 1   For i = 2 To m - 1    c(m + 1 - i, m + 1 - j) = c(m - i, m - j) + 2 * m - 2   Next i   Next j    x = m * m + 1 '计算互补数   For i = 1 To (m - 1) / 2
       '填写右边框       c(i + 1, m) = i       c(1, i) = i + (3 * m - 3) / 2
       '填写上边框       c(i + 1, 1) = x - i       If i = 1 Then          c(m, m) = x - c(1, i)       Else           c(m, i) = x - c(1, i)       End If   Next i   c(m, 1) = (m + 1) / 2   '左下角   c(1, m) = x - (m + 1) / 2   '右上角   For i = (m + 3) / 2 To m - 1
       '下侧赋值       j = i - (m + 1) / 2       c(m, m - j) = i       c(1, m - j) = x - i       '左侧赋值       c(m - j, 1) = m + j       c(m - j, m) = x - m - j   Next i   c(1, (m + 1) / 2) = m   '上侧居中格   c(m, (m + 1) / 2) = x - m   '下侧居中格   Next n   '输出构造的幻方串For i = 1 To mFor j = 1 To mCells(i + 3, j + 3) = c(i, j)  Next j    Next i    '给中心幻方对应格染色    For i = 1 To sFor j = 1 To s Cells(i + (m - s) / 2 + 3, j + (m - s) / 2 + 3).Select myColor = 0With Selection.Interior.ColorIndex = myColor.Pattern = xlSolidEnd WithNext jNext i
'给各层幻方串对应格染色For k = 1 To aFor j = 1 To m - 2 * k + 2Union(Cells(k - 1 + j + 3, m - k + 4), Cells(k + 3, j + k - 1 + 3), Cells(j + k - 1 + 3, k + 3), Cells(m - k + 4, j + k - 1 + 3)).Select myColor = k Mod 15 + 2With Selection.Interior.ColorIndex = myColor.Pattern = xlSolidEnd WithNext j Next k End SubSub 偶阶幻方串构造程序()Dim i, j, x, v, u As IntegerDim c(1000, 1000) '数组p可以装入1000*1000个数m = Cells(2, 2) '幻方最大的阶数s = Cells(3, 2) '中心幻方的阶数a = (m - s) / 2 构造偶数阶幻方For i = 1 To sFor j = 1 To sc(i, j) = Cells(i + 3, j + 3)  Next j    Next i For n = 1 To a  m = s + 2 * n
'将中心幻方复制到中心     For j = 2 To m - 1   For i = 2 To m - 1       c(m + 1 - i, m + 1 - j) = c(m + 1 - i - 1, m + 1 - j - 1) + 2 * m - 2   Next i   Next j    '填写边缘   For i = 2 To m - 1       c(i, 1) = 0       c(1, i) = 0       c(i, m) = 0       c(m, i) = 0   Next    '填写四顶角(行，列)   c(1, 1) = 2 * m - 2   c(m, 1) = 2 * m - 3   c(1, m) = m * m - 2 * m + 4   c(m, m) = m * m - 2 * m + 3    If m Mod 4 = 2 Then      '单偶幻方       c(1, 2) = 1       c(m, 3) = 3       c(m, 4) = 4       c(1, 5) = 5       c(2, m) = 2 * m - 4       c(3, m) = 2 * m - 5       c(4, 1) = 2       c(5, m) = 6       u = 6  '其它边框赋值       v = m - 1       For j = u To v           Select Case j Mod 4           Case 2                c(1, j) = j + 1                c(j, 1) = 2 * m - j           Case 3               c(m, j) = j + 1                c(j, m) = 2 * m - j           Case 0                c(m, j) = j + 1                c(j, m) = 2 * m - j           Case 1                c(1, j) = j + 1                c(j, 1) = 2 * m - j           End Select       Next  '对其它边缘数字进行赋值
   Else  '双偶幻方       c(1, 2) = 1       c(m, 3) = 2       c(m, 4) = 3       c(1, 5) = 4       c(1, 6) = 5       c(m, 7) = 6             For i = 2 To 5       c(i, m) = 2 * m - i - 2       Next i             c(6, 1) = 2 * m - 8       c(7, 1) = 2 * m - 9       u = 8       v = m - 1       For j = u To v           Select Case j Mod 4           Case 2                c(1, j) = j - 1                c(j, 1) = 2 * m - j - 2           Case 3                c(m, j) = j - 1                c(j, m) = 2 * m - j - 2           Case 0                c(m, j) = j - 1                c(j, m) = 2 * m - j - 2           Case 1                c(1, j) = j - 1                c(j, 1) = 2 * m - j - 2           End Select       Next  '对其它边缘数字进行赋值   End If   For i = 2 To m - 1       c(1, i) = IIf(c(1, i) = 0, m * m + 1 - c(m, i), c(1, i))       c(i, 1) = IIf(c(i, 1) = 0, m * m + 1 - c(i, m), c(i, 1))       c(m, i) = IIf(c(m, i) = 0, m * m + 1 - c(1, i), c(m, i))      c(i, m) = IIf(c(i, m) = 0, m * m + 1 - c(i, 1), c(i, m))   Next   '给已赋值的数字的对应格填写互补数 Next n
 For i = 1 To mFor j = 1 To mCells(i + 3, j + 3) = c(i, j)  Next j    Next i   '给中心对应格染色  For i = 1 To sFor j = 1 To s Cells(i + (m - s) / 2 + 3, j + (m - s) / 2 + 3).SelectmyColor = 6  '给中心对应格染成黄色With Selection.Interior.ColorIndex = myColor.Pattern = xlSolidEnd WithNext jNext i   '给各层幻方串对应格染色For k = 1 To aFor j = 1 To m - 2 * k + 2Union(Cells(k + j + 2, m - k + 4), Cells(k + 3, j + k + 2), Cells(j + k + 2, k + 3), Cells(m - k + 4, j + k + 2)).Select myColor = k Mod 15 + 2With Selection.Interior.ColorIndex = myColor.Pattern = xlSolidEnd WithNext j Next k End Sub
智慧在幻方串的皱纹中喷涌，飞溅的数字瀑布连接着天际的彩虹。拾起一块90年代的幻方书，燃起编程的炉火将幻方构造方法锤锻，做成一行行灵巧的代码，雕塑着文字和语言。程序朦胧，在智慧的时代里醒来，我们希望幻方研究院里，幻方故园总是关不住，一套套程序陆续出墙来。
本站是提供个人知识管理的网络存储空间，所有内容均由用户发布，不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息，谨防诈骗。如发现有害或侵权内容，请点击一键举报。