Dim n As Byte, pz1() As Byte, pz2() As Byte, pz3() As Byte          '定义全局变量，其中n表示盘子的个数，pz1()~pz3()是记录每个杆子中盘子的情况，值为0表示没有盘子，值为几就表示第n个盘子在这个位置
Sub sleep(x As Byte)                                                '产生停顿x表示半秒
    Dim tim0 As Single, tim1 As Single
        tim0 = Timer
    While (tim0 + x / 2 >= tim1)
        tim1 = Timer
    Wend
End Sub
Sub hanoi(m As Byte, a() As Byte, b() As Byte, c() As Byte)         '核心代码，网上找的
    If m = 1 Then
        Call move1(a, c)
    Else
        Call hanoi(m - 1, a, c, b)
        Call move1(a, c)
        Call hanoi(m - 1, b, a, c)
    End If
End Sub
Sub move1(e() As Byte, f() As Byte)                                     '使要移动的盘子移到杆子的最上面
    sleep (1)                                                           '等待
    
    Shape1(e(1) - 1).Top = 45                                           '调用平移过程
    
    Call pingyi(e, f)                                                   '对该杆子数组重新初始化，因为最上面的盘子被移走了
    For i = 1 To n - 1
        e(i) = e(i + 1)
    Next
    e(n) = 0
End Sub
Sub pingyi(g() As Byte, h() As Byte)                                     '平行移动盘子
    sleep (1)
    
    Shape1(g(1) - 1).Move h(0) - Shape1(g(1) - 1).Width / 2                  '对该杆子数组重新初始化，因为又增加了一个盘子
    
    For i = n To 2 Step -1
        h(i) = h(i - 1)
    Next
    
    h(1) = g(1)
    Call down(g, h)                                                         '调用下移过程
End Sub
Sub down(j() As Byte, k() As Byte)
    Dim l As Byte                                                               '判断杆子之前有没有盘子
    sleep (1)
    
    For i = 2 To n
        l = l + k(i)
    Next
    
    If l = 0 Then
        Shape1(j(1) - 1).Top = 20 + Shape1(j(1) - 1).Height                            '移动并初始化
    Else
        For i = 2 To n
            If k(i) <> 0 Then
                Shape1(j(1) - 1).Top = Shape1(k(i) - 1).Top + Shape1(k(i) - 1).Height
                Exit For
            End If
        Next
    End If
End Sub



Private Sub Command1_Click(Index As Integer)
    If Index = 0 Then
        Call hanoi(n, pz1, pz2, pz3)                  '开始移动
    Else
        End
    End If
End Sub

Private Sub Form_Load()
Dim z As String
Scale (0, 60)-(4, 0)            '初始化，定义窗体坐标
DrawWidth = 5

Line (1, 20)-(1, 45), vbBlue    '画出杆子
Line (2, 20)-(2, 45), vbBlue
Line (3, 20)-(3, 45), vbBlue
Line (0.5, 20)-(3.5, 20), vbBlue

Do
    z = InputBox("请输入盘子的个数(2~7)", "提示", 3, Screen.Width * 0.3, Screen.Height * 0.3) '提示输入盘子数
    If z = "" Then
        End
    Else
        n = Val(z)
    End If
Loop Until (n >= 2 And n <= 7)

With Shape1(0)                                                                        '对窗体上母盘初始化位置、大小
    .Width = 0.8
    .Left = 1 - Shape1(0).Width / 2
    .Top = 20 + Shape1(0).Height
End With

For i = 1 To n - 1                                                                      '装载剩余的盘子并初始化
    Load Shape1(i)
    With Shape1(i)
        .Visible = True
        .Width = Shape1(i - 1).Width - 0.1
        .Left = 1 - Shape1(i).Width / 2
        .Top = Shape1(i - 1).Top + Shape1(i - 1).Height
    End With
Next

ReDim pz1(0 To n)                                                                       '初始化三个数组
ReDim pz2(0 To n)
ReDim pz3(0 To n)

For i = 1 To n
    pz1(i) = n + 1 - i
    pz2(i) = 0
    pz3(i) = 0
Next

pz1(0) = 1                                                                              '初始化，这里的1、2、3是三个杆子的标记，也是它们的横坐标，移动时要使用
pz2(0) = 2
pz3(0) = 3
End Sub

我写的，请大家批评指点。谢谢。

怎么没有人支持我一下呀？

呵呵,见识浅薄,我连这个"河内塔"的意思都没明白.

河内塔（又称汉诺塔）问题是印度的一个古老的传说。开天辟地的神勃拉玛在一个庙里留下了三根金刚石的棒，第一根上面套着64个圆的金片，最大的一个在底下，其余一个比一个小，依次叠上去，庙里的众僧不倦地把它们一个个地从这根棒搬到另一根棒上，规定可利用中间的一根棒作为帮助，但每次只能搬一个，而且大的不能放在小的上面。解答结果请自己运行计算，程序见尾部。面对庞大的数字(移动圆片的次数)18446744073709551615，看来，众僧们耗尽毕生精力也不可能完成金片的移动。
　　后来，这个传说就演变为汉诺塔游戏:  
　　1.有三根杆子A,B,C。A杆上有若干碟子  
　　2.每次移动一块碟子,小的只能叠在大的上面  
　　3.把所有碟子从A杆全部移到C杆上


来自百度百科。

哦,原来如此,顶上.
有方程式吗?

什么方程式呀，我不太明白什么意思？你可以网上搜搜呀