📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 8805
ClientLeft = 60
ClientTop = 345
ClientWidth = 10875
LinkTopic = "Form1"
ScaleHeight = 8805
ScaleWidth = 10875
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "移动盘子"
Height = 615
Left = 2040
TabIndex = 5
Top = 5880
Width = 3135
End
Begin VB.TextBox Text1
BackColor = &H0080FF80&
BeginProperty Font
Name = "楷体_GB2312"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 1200
TabIndex = 4
Text = "4"
Top = 5160
Width = 1095
End
Begin VB.TextBox Text2
BackColor = &H0080FF80&
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3120
TabIndex = 3
Top = 5160
Width = 1095
End
Begin VB.TextBox Text3
BackColor = &H0080FF80&
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1200
TabIndex = 2
Text = "1"
Top = 4080
Width = 1095
End
Begin VB.TextBox Text4
BackColor = &H0080FF80&
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3120
TabIndex = 1
Text = "2"
Top = 4080
Width = 1095
End
Begin VB.TextBox Text5
Height = 495
Left = 5520
TabIndex = 0
Text = "0.2"
Top = 5160
Width = 1815
End
Begin VB.Label Label9
BackColor = &H00FFFFC0&
Caption = " 柱 4"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8400
TabIndex = 14
Top = 3480
Width = 975
End
Begin VB.Line Line1
Index = 4
X1 = 8880
X2 = 8880
Y1 = 0
Y2 = 3360
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 3
Left = 240
Shape = 4 'Rounded Rectangle
Top = 2640
Width = 1695
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 2
Left = 120
Shape = 4 'Rounded Rectangle
Top = 2880
Width = 1935
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 1
Left = 0
Shape = 4 'Rounded Rectangle
Top = 3120
Width = 2175
End
Begin VB.Line Line1
Index = 3
X1 = 6360
X2 = 6360
Y1 = 0
Y2 = 3360
End
Begin VB.Line Line1
Index = 2
X1 = 3600
X2 = 3600
Y1 = 0
Y2 = 3360
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 4
Left = 360
Shape = 4 'Rounded Rectangle
Top = 2400
Width = 1455
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 5
Left = 480
Shape = 4 'Rounded Rectangle
Top = 2160
Width = 1215
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 6
Left = 600
Shape = 4 'Rounded Rectangle
Top = 1920
Width = 975
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 7
Left = 720
Shape = 4 'Rounded Rectangle
Top = 1680
Width = 735
End
Begin VB.Line Line1
Index = 1
X1 = 1080
X2 = 1080
Y1 = 0
Y2 = 3360
End
Begin VB.Label Label1
BackColor = &H00FFFFC0&
Caption = "盘子数目"
Height = 375
Left = 720
TabIndex = 13
Top = 4920
Width = 855
End
Begin VB.Label Label2
BackColor = &H00FFFFC0&
Caption = "移动次数"
Height = 255
Left = 2640
TabIndex = 12
Top = 4920
Width = 1215
End
Begin VB.Label Label3
BackColor = &H00FFFFC0&
Caption = " 柱 1"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 600
TabIndex = 11
Top = 3480
Width = 975
End
Begin VB.Label Label6
BackColor = &H00FFFFC0&
Caption = " 柱 3"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5880
TabIndex = 10
Top = 3480
Width = 975
End
Begin VB.Label Label7
BackColor = &H00FFFFC0&
Caption = " 柱 2"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3120
TabIndex = 9
Top = 3480
Width = 975
End
Begin VB.Label Label4
BackColor = &H00FFFFC0&
Caption = "从柱"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 480
TabIndex = 8
Top = 4080
Width = 735
End
Begin VB.Label Label5
BackColor = &H00FFFFC0&
Caption = "到柱"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2400
TabIndex = 7
Top = 4080
Width = 735
End
Begin VB.Label Label8
BackColor = &H00FFFFC0&
Caption = "延时参数"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5520
TabIndex = 6
Top = 4800
Width = 2295
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim a, b, c As Integer
Dim pan(4, 7) As Integer '数组存放盘子号码
'盘子数目
Dim heightt(4) As Integer '高度
Dim j As Integer
Dim k As Integer
Dim topp(4) As Integer
Dim m As Integer
Dim t As Integer
Dim timet As Double
Private Sub Command1_Click()
t = 0
Command1.Enabled = False
m = Text1.Text
timet = Text5.Text
a = 1: b = 2: c = 3: d = 4 '设计这四个变量是为了使用line1(i)数组，然后利用它们的left,height ,属性
'设计这四变量，并取相应的值，可以方便的读取对应的柱子
For i = m + 1 To 7
Shape1(i).Visible = False '多余的不作要求的盘子不可见
Next i
For i = 1 To m
Shape1(i).Visible = True '万一原来移动3个，然后又要移动3个以上，所以那些3以上的盘子要恢复可见
Next i
j = Text3.Text '从j移动到k盘
k = Text4.Text
If j = 2 Then
For i = 1 To 7
Shape1(i).Left = 2760 + (i - 1) * 120 '以下四个判断，四个循环是为了将盘子放到初始的位置
Next i
End If
If j = 3 Then
For i = 1 To 7
Shape1(i).Left = 5520 + (i - 1) * 120
Next i
End If
If j = 1 Then
For i = 1 To 7
Shape1(i).Left = 0 + (i - 1) * 120
Next i
End If
If j = 4 Then
For i = 1 To 7
Shape1(i).Left = 7800 + (i - 1) * 120
Next i
End If
Call delay(1)
For i = 1 To m
pan(j, i) = i '将数组初始化，这样shape1(pan(j,i))的参数就到位了，pan(j,i)只是为了做一个参数
Next i
For i = 1 To 4
If i = j Then
topp(i) = m '总共有m个盘子要移动
Else: topp(i) = 0
End If
Next i
For i = 1 To 4
If i = j Then
heightt(i) = Shape1(pan(j, topp(j))).Top '保存高度，为有盘子移过来做好准备
Else: heightt(i) = Line1(i).Y2
End If
Next i
If j + k = 3 Then Call movea(1, 3, 4, 2, m)
If j + k = 4 Then Call movea(1, 2, 4, 3, m)
If j + k = 6 Then Call movea(2, 1, 3, 4, m)
If j + k = 7 Then Call movea(3, 1, 2, 4, m)
If j = 1 And k = 4 Then Call movea(1, 2, 3, 4, m)
If j = 4 And k = 1 Then Call movea(4, 2, 3, 1, m)
If j = 2 And k = 3 Then Call movea(2, 1, 4, 3, m)
If j = 3 And k = 2 Then Call movea(3, 1, 4, 2, m)
Command1.Enabled = True
End Sub
Function movea(a, b, c, d, n As Integer)
If n > 2 Then
Call movea(a, b, d, c, n - 2) '中间两个参数位置可以互换
Call movea(a, c, d, b, 1)
Call movea(a, b, c, d, 1)
Call movea(b, a, c, d, 1)
Call movea(c, a, b, d, n - 2)
Else
If n = 2 Then
Call movea(a, b, d, c, 1)
Call movea(a, b, c, d, 1)
Call movea(c, a, b, d, 1)
End If
If n = 1 Then Call realmove(a, d)
End If
End Function
Function realmove(a, c)
Shape1(pan(a, topp(a))).FillColor = vbRed
Shape1(pan(a, topp(a))).Top = Line1(a).Y1
Call delay(timet)
Shape1(pan(a, topp(a))).Left = Line1(c).X1 - Shape1(pan(a, topp(a))).Width / 2
Call delay(timet)
Shape1(pan(a, topp(a))).Top = heightt(c) - Shape1(pan(a, topp(a))).Height
Call delay(timet)
Shape1(pan(a, topp(a))).FillColor = &H80FF80
heightt(a) = heightt(a) + Shape1(pan(a, topp(a))).Height
heightt(c) = heightt(c) - Shape1(pan(a, topp(a))).Height
topp(c) = topp(c) + 1
pan(c, topp(c)) = pan(a, topp(a))
topp(a) = topp(a) - 1
t = t + 1
Text2.Text = t
End Function
Function delay(h As Double)
Dim delaytime, start
delaytime = h
start = Timer
Do While Timer < start + delaytime
Loop
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -