汉诺塔动画（修复了了两个问题），很少发主题帖， 大家提提意见吧

liulang0808

极少发主题帖，今天抽空临时做了个汉诺塔动画，靠循环次数控制画面移动的。

由于时间不够了，做了半成品
存在问题：
1、相邻两个盘子移动一个，另一个边线受影响
2、盘子挪动后，需要落到柱子的最下面盘子上面，现在有悬空的，需要调整

其他可能还存在问题，请大家完善吧

liulang0808

修复了以上的两个问题。。。。

XIHUANEXCELJLT

不错，挺好的。

XIHUANEXCELJLT

liulang0808 发表于 2014-11-4 19:56
修复了以上的两个问题。。。。

速度也快了 很好

香川群子

呵呵，是否可以做成平面的圆形重叠，通过颜色底色的显示、不显示就可以了。不需要移动圆片的位置的。

…………
有空我来写一个。

liulang0808

香川群子 发表于 2014-11-5 10:06
呵呵，是否可以做成平面的圆形重叠，通过颜色底色的显示、不显示就可以了。不需要移动圆片的位置的。

… ...

谢谢群子老师的建议。当时只是感觉有现成的表格边框可以利用，就直接使用了

香川群子

经典汉诺塔游戏递归算法原理的说明：
http://club.excelhome.net/thread-1074709-1-1.html

达州张先生

liulang0808 发表于 2014-11-4 19:56
修复了以上的两个问题。。。。

高手就是不一样。谢谢分享

香川群子

呵呵，我的代码很简单。

下面是图例。

香川群子

相关代码：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address = "$E$1" Then Call Hanoi(Target.Value) '改变E1中数值时自动开始
   
3. End Sub
   
4. 
   
5. Sub Hanoi(n) '初始化
   
6.     For i = 0 To 26
   
7.         t = Chr(i \ 9 + 65) & "_" & (i Mod 9 + 1)
   
8.         ActiveSheet.Shapes(t).Visible = IIf(i < n, True, False) '显示或不显示
   
9.     Next
   
10.     Call dg_Hanoi(n, "A", "C", "B") '调用递归
    
11. End Sub
    
12. 
    
13. Sub dg_Hanoi(n, a, c, b) '递归过程
    
14.     If n = 1 Then
    
15.         Range("K65536").End(xlUp).Offset(1) = "Move " & n & ": " & a & "->" & c '在K列记录过程
    
16.         Range("G18") = "Move " & n & ": " & a & "->" & c  '在G18显示当前步骤        
    
17.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
    
18.         ActiveSheet.Shapes(a & "_" & n).Visible = False '移走不显示
    
19.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
    
20.         ActiveSheet.Shapes(c & "_" & n).Visible = True '移到后显示
    
21.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
    
22. 
    
23.     Else
    
24.         Call dg_Hanoi(n - 1, a, b, c)
    
25. 
    
26.         Range("K65536").End(xlUp).Offset(1) = "Move " & n & ": " & a & "->" & c '在K列记录过程
    
27.         Range("G18") = "Move " & n & ": " & a & "->" & c  '在G18显示当前步骤        
    
28.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
    
29.         ActiveSheet.Shapes(a & "_" & n).Visible = False '移走不显示
    
30.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
    
31.         ActiveSheet.Shapes(c & "_" & n).Visible = True '移到后显示
    
32.         Application.Wait Now + TimeValue("00:00:01") '延时1秒
    
33. 
    
34.         Call dg_Hanoi(n - 1, b, c, a)
    
35.     End If
    
36. End Sub

复制代码