loopfill.frm

Visual Basic课程举例1 有很好的例题

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "转圈填数"
   ClientHeight    =   8025
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9735
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   8025
   ScaleWidth      =   9735
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   7335
      Left            =   0
      ScaleHeight     =   7305
      ScaleWidth      =   9705
      TabIndex        =   5
      Top             =   720
      Width           =   9735
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   5040
      TabIndex        =   4
      Text            =   "5"
      Top             =   240
      Width           =   615
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   2040
      TabIndex        =   1
      Text            =   "5"
      Top             =   240
      Width           =   615
   End
   Begin VB.CommandButton CmdFill 
      Caption         =   "转圈填数"
      Height          =   495
      Left            =   6240
      TabIndex        =   0
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label Label2 
      Caption         =   "输入列数(2-20)"
      Height          =   255
      Left            =   2880
      TabIndex        =   3
      Top             =   240
      Width           =   1935
   End
   Begin VB.Label Label1 
      Caption         =   "输入行数(2-30)"
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   1695
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'VB演示程序
'
'本程序演示了动态数组的使用。
'
'设计：曹新国
'日期：2008年4月

' 程序用法：（略）
'
' 功能扩展指南：
'
' 可以考虑起始填充位置不是左上角的情况，还可以考虑按其它路线进行填充。


Private Sub CmdFill_Click()
'变量说明：
'A是数组，M是行数，N是列数
Dim A() As Integer, M As Integer, N As Integer, I As Integer
'findNextPosition 是是否能找到下一个位置的指示, D是填充方向，1=右，2=下，3=左，4=上
Dim findNextPosition As Boolean, D As Integer
'L和C要填入数的当前位置的行号和列号
Dim L As Integer, C As Integer

'取得用户指定的行数和列数
M = Val(Text1)
N = Val(Text2)

'将用户输入的数值调节到合理的范围内：行数2-30，列数2-20
If M < 2 Then M = 2
If M > 30 Then M = 30
If N < 2 Then N = 2
If N > 20 Then N = 20

'定义操作用的数组，上下左右各多出一行/列，否则会增加处理难度
'REDIM语句执行后，整形数组的所有值全部置为0，不需要额外的“将全部元素初始化为0”的操作
ReDim A(0 To M + 1, 0 To N + 1)

' 开始时，从左上角(行1列1)向右（D：1）填充
D = 1
L = 1
C = 1

'共需要填充M*N个数
For I = 1 To M * N
    '将要填充的数放入当前位置
    A(L, C) = I
    '如果已经填充完成，退出循环
    If I = M * N Then Exit For
    
    '查找下一个可用位置，规则是位置在阵列内且数值为0
    findNextPosition = False
    Do
        Select Case D
        Case 1  '如果当前方向是向右填充
            '如果右面的位置没有填过数，且没有超出边界，则列号加1，下一个可用位置已经找到！
            If A(L, C + 1) = 0 And C + 1 <= N Then
                C = C + 1
                findNextPosition = True
            Else
                '否则只好向下搜索可用位置
                D = D + 1
            End If
        Case 2  ' 当前方向为向下时,改变和判断的都是行号，和向右的处理方法类似
            If A(L + 1, C) = 0 And L + 1 <= M Then
                L = L + 1
                findNextPosition = True
            Else
                D = D + 1
            End If
        Case 3  ' 向左
            If A(L, C - 1) = 0 And C - 1 >= 1 Then
                C = C - 1
                findNextPosition = True
            Else
                D = D + 1
            End If
        Case 4   ' 向上
            If A(L - 1, C) = 0 And L - 1 >= 1 Then
                L = L - 1
                findNextPosition = True
            Else
                D = 1
            End If
        End Select
    '一直查找，直到找到一下个可用位置
    Loop Until findNextPosition
Next I

'在图片框上输入填充结果，首先要清除图片框的原有内容
Picture1.Cls
For I = 1 To M
    For j = 1 To N
        Picture1.Print Format(A(I, j), " 000");
    Next j
    Picture1.Print
Next I
End Sub