蛇行矩阵算法

来源:互联网 发布:如何防止sql注入漏洞 编辑:程序博客网 时间:2024/04/30 14:34

      上次在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

原创粉丝点击