上次在csdn上有人问了关于螺行矩阵算法的问题,出于感兴趣,写了下面的代码,希望各位大大指正,或提出其他算法.
代码部分:
Option Explicit
Dim i As Integer '矩阵大小
Dim Mix() As Integer '矩阵
Dim iSaveVal As Integer '保存上一个位置的值
Dim row, col As Integer '行、列
Dim way As String '数字行走方向(down、rightup、right、leftdown)
Private Sub Command1_Click()
Dim iCount As Integer
Dim nX As Integer
Dim Num As Integer
Dim sFileName As String
i = InputBox("请输入一个值")
ReDim Mix(1 To i, 1 To i)
For row = 1 To i
For col = 1 To i
If (row = 1) Or (col = 1) Or (row = i) Or (col = i) Then
Mix(row, col) = -1
Else
Mix(row, col) = 0
End If
Next
Next
For nX = 1 To i
iCount = iCount + nX '上三角元素个数(包括对角线)
Next
Mix(1, 1) = 1 '初始化第一个数的值
way = "down" '初始化方向
row = 1
col = 1 '初始化位置
iSaveVal = Mix(1, 1)
Do While iCount - 1
Select Case way
Case "down"
row = row + 1
If Mix(row, col) = -1 Then
way = "rightup"
End If
Mix(row, col) = iSaveVal + 1
iSaveVal = Mix(row, col)
Case "rightup"
row = row - 1
col = col + 1
If Mix(row, col) = -1 Then
way = "right"
End If
Mix(row, col) = iSaveVal + 1
iSaveVal = Mix(row, col)
Case "right"
col = col + 1
If Mix(row, col) = -1 Then
way = "leftdown"
End If
Mix(row, col) = iSaveVal + 1
iSaveVal = Mix(row, col)
Case "leftdown"
row = row + 1
col = col - 1
If Mix(row, col) = -1 Then
way = "down"
End If
Mix(row, col) = iSaveVal + 1
iSaveVal = Mix(row, col)
End Select
iCount = iCount - 1
Loop
iCount = 0
'下三角元素个数
For nX = 1 To i - 1
iCount = iCount + nX
Next
If i Mod 2 = 0 Then
row = 1
col = i
way = "down"
Else
row = i
col = 1
way = "right"
End If
Do While iCount
Select Case way
Case "right"
col = col + 1
If Mix(row, col) = -1 Then
way = "rightup"
End If
Mix(row, col) = iSaveVal + 1
iSaveVal = Mix(row, col)
Case "rightup"
row = row - 1
col = col + 1
If Mix(row, col) = -1 Then
way = "down"
End If
Mix(row, col) = iSaveVal + 1
iSaveVal = Mix(row, col)
Case "down"
row = row + 1
If Mix(row, col) = -1 Then
way = "leftdown"
End If
Mix(row, col) = iSaveVal + 1
iSaveVal = Mix(row, col)
Case "leftdown"
row = row + 1
col = col - 1
If Mix(row, col) = -1 Then
way = "right"
End If
Mix(row, col) = iSaveVal + 1
iSaveVal = Mix(row, col)
End Select
iCount = iCount - 1
Loop
sFileName = "c:/1.txt"
Num = FreeFile
Open sFileName For Binary Access Write As #Num
For row = 1 To i
For col = 1 To i
Put #Num, , CStr(Mix(row, col))
Put #Num, , CStr(" ")
If col = i Then
Put #Num, , vbCrLf
End If
Next
Next
Close #Num
End Sub