📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BackColor = &H00FFFFC0&
Caption = "Form1"
ClientHeight = 7125
ClientLeft = 2340
ClientTop = 1320
ClientWidth = 8430
FillColor = &H00C0FFFF&
FillStyle = 0 'Solid
ForeColor = &H00FFFFFF&
LinkTopic = "Form1"
ScaleHeight = 7125
ScaleWidth = 8430
Begin VB.TextBox Text5
Height = 495
Left = 5760
TabIndex = 12
Text = "0.2"
Top = 5760
Width = 1815
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 = 3360
TabIndex = 9
Text = "2"
Top = 4680
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 = 1440
TabIndex = 8
Text = "1"
Top = 4680
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 = 3360
TabIndex = 3
Top = 5760
Width = 1095
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 = 1440
TabIndex = 1
Text = "4"
Top = 5760
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "移动盘子"
Height = 615
Left = 2280
TabIndex = 0
Top = 6480
Width = 3135
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 = 5760
TabIndex = 13
Top = 5400
Width = 2295
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 = 2640
TabIndex = 11
Top = 4680
Width = 735
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 = 720
TabIndex = 10
Top = 4680
Width = 735
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 = 3360
TabIndex = 7
Top = 4080
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 = 6120
TabIndex = 6
Top = 4080
Width = 975
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 = 840
TabIndex = 5
Top = 4080
Width = 975
End
Begin VB.Label Label2
BackColor = &H00FFFFC0&
Caption = "移动次数"
Height = 255
Left = 2880
TabIndex = 4
Top = 5520
Width = 1215
End
Begin VB.Label Label1
BackColor = &H00FFFFC0&
Caption = "盘子数目"
Height = 375
Left = 960
TabIndex = 2
Top = 5520
Width = 855
End
Begin VB.Line Line1
Index = 1
X1 = 1320
X2 = 1320
Y1 = 600
Y2 = 3960
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 7
Left = 960
Shape = 4 'Rounded Rectangle
Top = 2280
Width = 735
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 6
Left = 840
Shape = 4 'Rounded Rectangle
Top = 2520
Width = 975
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 5
Left = 720
Shape = 4 'Rounded Rectangle
Top = 2760
Width = 1215
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 4
Left = 600
Shape = 4 'Rounded Rectangle
Top = 3000
Width = 1455
End
Begin VB.Line Line1
Index = 2
X1 = 3840
X2 = 3840
Y1 = 600
Y2 = 3960
End
Begin VB.Line Line1
Index = 3
X1 = 6600
X2 = 6600
Y1 = 600
Y2 = 3960
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 1
Left = 240
Shape = 4 'Rounded Rectangle
Top = 3720
Width = 2175
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 2
Left = 360
Shape = 4 'Rounded Rectangle
Top = 3480
Width = 1935
End
Begin VB.Shape Shape1
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 255
Index = 3
Left = 480
Shape = 4 'Rounded Rectangle
Top = 3240
Width = 1695
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(3, 7) As Integer '数组存放盘子号码
'盘子数目
Dim heightt(3) As Integer '高度
Dim j As Integer
Dim k As Integer
Dim topp(3) 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
For i = m + 1 To 7
Shape1(i).Visible = False
Next i
For i = 1 To m
Shape1(i).Visible = True
Next i
j = Text3.Text
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 = 240 + (i - 1) * 120
Next i
End If
Call delay(1)
For i = 1 To m
pan(j, i) = i
Next i
For i = 1 To 3
If i = j Then
topp(i) = m
Else: topp(i) = 0
End If
Next i
For i = 1 To 3
If i = j Then
heightt(i) = Shape1(pan(j, topp(j))).Top
Else: heightt(i) = Line1(i).Y2
End If
Next i
Call movea(j, 6 - k - j, k, m)
Command1.Enabled = True
End Sub
Function movea(a, b, c, n As Integer)
If n > 1 Then
Call movea(a, c, b, n - 1)
Call movea(a, b, c, 1)
Call movea(b, a, c, n - 1)
Else: Call realmove(a, c)
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 + -