form1.frm

这是一个四阶幻方生成器

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "4阶幻方生成"
   ClientHeight    =   3735
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   2685
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3735
   ScaleWidth      =   2685
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      Height          =   2415
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   120
      Width           =   2415
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   3240
      Width           =   2415
   End
   Begin VB.Label Label1 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   2760
      Width           =   2415
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim R(1 To 16) As Integer

Private Sub Magic4()
'求四阶幻方
'亳州三中教科处王宇，[e-mail]
'************************************
Dim a11, a12, a13, a14, a21, a22, a23, a24, a31, a32, a33, a34, a41, a42, a43, a44 As Integer
Dim count As Long  '共458752次
Dim Result As String
Dim time As Date
time = Now
Result = ""
count = 0
For a11 = 1 To 7
  For a12 = 2 To 16
       
       For a21 = 2 To 16
            For a13 = 1 To 16
 
                For a31 = 1 To 16
                   
                    count = count + 1
                     If count Mod 1000 = 0 Then
                       Label1.Caption = "当前进度:" & Str(count) & "/458752"
                       Label1.Refresh
                     End If
                    a14 = 34 - a11 - a12 - a13
                    a41 = 34 - a11 - a21 - a31
                    a22 = 34 - a11 - a12 - a21
                    a42 = 34 - a11 - a12 - a41
                    a32 = 34 - a12 - a22 - a42
                    a23 = 34 - a41 - a32 - a14
                    a24 = 34 - a21 - a22 - a23
                    a33 = 34 - a22 - a23 - a32
                    a44 = 34 - a11 - a22 - a33
                    a43 = 34 - a41 - a42 - a44
                    a34 = 34 - a14 - a24 - a44
                    R(1) = a11: R(2) = a12: R(3) = a13: R(4) = a14
                    R(5) = a21: R(6) = a22: R(7) = a23: R(8) = a24
                    R(9) = a31: R(10) = a32: R(11) = a33: R(12) = a34
                    R(13) = a41: R(14) = a42: R(15) = a43: R(16) = a44
                    If Judge16() Then
                        Result = Result & a11 & "," & a12 & "," & a13 & "," & a14 & vbCrLf _
                                        & a21 & "," & a22 & "," & a23 & "," & a24 & vbCrLf _
                                        & a31 & "," & a32 & "," & a33 & "," & a34 & vbCrLf _
                                        & a41 & "," & a42 & "," & a43 & "," & a44 & vbCrLf & vbCrLf
                    End If
                   
                
               Next a31
            Next a13
        Next a21
    Next a12
Next a11
Text1.Text = Result
time = Now - time
Label1.Caption = "共用时：" & time & "秒"
End Sub
Private Function Judge16() As Boolean
'该函数判断一个包含16个数的数组是否是由1-16，16个不同的自然数组成的。
'说明：采用了对号入座算法；
'先判断数字的合法性（是否在1-16之间）
'例如数字8,占T(8)的位置，如果再一次出现8，由于T(8)不为0，从而判断出这个集合不符合要求。
'亳州三中教科处王宇，[e-mail]
'************************************
Dim T(1 To 16) As Integer
Dim i As Integer
   Judge16 = False
   '清空座位
   For i = 1 To 16
     T(i) = 0
   Next i
   For i = 1 To 16
     If R(i) < 1 Or R(i) > 16 Then Exit Function    '是否有资格进场
     If T(R(i)) = 0 Then T(R(i)) = R(i) Else Exit Function  '座位是否被占
   Next i
   Judge16 = True
End Function
Private Function Judge16b() As Boolean
'该函数判断一个包含16个数的数组是否是由1-16，16个不同的自然数组成的。
'说明：采用了对号入座算法；
'亳州三中教科处王宇，[e-mail]
'************************************

Dim i As Long, Judge As Long
 Judge16b = False
 Judge = 0
 For i = 1 To 16
  If R(i) < 1 Or R(i) > 16 Then Exit Function    '是否有资格进场
  Judge = Judge Or (2 ^ R(i))
  If Judge = 131070 Then Judge16b = True
 Next i
End Function





Private Sub Command1_Click()
Magic4
End Sub