求助vb螺行矩阵算法的Robby82822 (第七灵感) 进来看下

[wangtopcool]

因为不能连续写三次所以另开了一个帖

我下面这个应该没有什么问题了,欢迎各位大大指正或是提出新的思路
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