📄 换位法.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1
Caption = "组合数学算法演示--换位法"
ClientHeight = 3225
ClientLeft = 60
ClientTop = 345
ClientWidth = 5325
Icon = "换位法.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3225
ScaleWidth = 5325
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text3
Height = 375
Left = 2160
TabIndex = 7
Top = 480
Width = 1455
End
Begin ComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 6
Top = 2850
Width = 5325
_ExtentX = 9393
_ExtentY = 661
Style = 1
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 1
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
EndProperty
EndProperty
End
Begin VB.TextBox Text2
Height = 1095
Left = 120
MultiLine = -1 'True
TabIndex = 5
Top = 1680
Width = 5055
End
Begin VB.TextBox Text1
Height = 375
Left = 240
TabIndex = 4
Top = 480
Width = 1455
End
Begin VB.CommandButton Command2
Caption = "清 空"
Height = 375
Left = 3960
TabIndex = 1
Top = 960
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "计 算"
Height = 375
Left = 3960
TabIndex = 0
Top = 360
Width = 1095
End
Begin VB.Line Line1
BorderColor = &H80000005&
X1 = 120
X2 = 5160
Y1 = 1590
Y2 = 1590
End
Begin VB.Label Label2
Caption = "下一个排列："
Height = 255
Left = 1920
TabIndex = 3
Top = 120
Width = 1215
End
Begin VB.Label Label1
Caption = "初始排列："
Height = 255
Left = 360
TabIndex = 2
Top = 120
Width = 1215
End
Begin VB.Line Line2
X1 = 120
X2 = 5160
Y1 = 1560
Y2 = 1560
End
Begin VB.Label Label3
Caption = "计算处理过程演示："
Height = 375
Left = 240
TabIndex = 8
Top = 1200
Width = 1815
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim E(15) As Integer
Dim A(40) As Integer
Dim textstring As String
Dim D(15) As Integer
Private Sub Command1_Click()
Dim p As Integer
Dim q As Integer
Dim m, n As Integer
textstring = Text1.Text
Text1.Text = ""
Text2.Text = ""
'S1
'读取输入序列
For i = 1 To 15
A(i) = Val(Mid(textstring, i, 1))
Next
Text1.Text = A(1) & A(2) & A(3) & A(4) & A(5) & A(6) & A(7) & A(8) & A(9) & A(10) & A(11) & A(12) & A(13) & A(14) & A(15)
For m = 1 To 4
n = A(m)
Select Case n
Case 1
D(1) = m
Case 2
D(2) = m
Case 3
D(3) = m
Case 4
D(4) = m
End Select
Next
'StatusBar1.SimpleText = StatusBar1.SimpleText & D(1) & D(2) & D(3) & D(4)
'D(1) = 2
'D(2) = 3
'D(3) = 1
'D(4) = 4
For i = 1 To 4
E(i) = -1
Next
'S2
S2: q = 0
For j = 1 To 4
Text2.Text = Text2.Text & A(j)
Next
Text2.Text = Text2.Text & " "
'S3
For k = 4 To 2 Step -1
D(k) = D(k) + E(k)
p = D(k)
If p = k Then
E(k) = -1
Else
If p = 0 Then
E(k) = 1
q = q + 1
Else
p = p + q
r = A(p)
A(p) = A(p + 1)
A(p + 1) = r
GoTo S2
' For i = 1 To 4
' Text2.Text = Text2.Text & A(i)
' Next
' Text2.Text = Text2.Text & " "
End If
End If
Next
Text3.Text = ""
Text3.Text = A(1) & A(2) & A(3) & A(4)
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub Command3_Click()
Dim p As Integer
Dim q As Integer
Dim max, n As Integer
Dim astatus(4) As Integer
textstring = Text1.Text
Text1.Text = ""
Text2.Text = ""
'S1
'读取输入序列
A(0) = 5
A(6) = 5
For i = 1 To 4
A(i) = Val(Mid(textstring, i, 1))
Next
For i = 1 To 4
E(i) = -1
Next
'判断对应位置
'For j = 1 To 4
' Select Case A(j)
' Case 1
' D(1) = j
' Case 2
' D(2) = j
' Case 3
' D(3) = j
' Case 4
' D(4) = j
' End Select
' StatusBar1.SimpleText = D(1) & D(2) & D(3) & D(4)
'Next
's1
s1: For i = 1 To 4
If E(i) = -1 Then
If A(i - 1) < A(i) Then
astatus(i) = 1
Else
astatus(i) = 0
End If
Else
If A(i) > A(i + 1) Then
astatus(i) = 1
Else
astatus(i) = 0
End If
End If
Next
If astatus(1) = 0 And astatus(2) = 0 And astatus(3) = 0 And astatus(4) = 0 Then GoTo S4
's2
max = 0
n = 0
For i = 1 To 4
If astatus(i) = 1 And max < A(i) Then
max = A(i)
n = i
End If
Next
If E(n) = -1 Then
A(40) = A(n)
A(n) = A(n - 1)
A(n - 1) = A(40)
Else
A(40) = A(n)
A(n) = A(n + 1)
A(n + 1) = A(40)
End If
For i = 1 To 4
If max < A(i) And E(i) = 1 Then
E(i) = -1
End If
If max < A(i) And E(i) = -1 Then
E(i) = 1
End If
Next
'GoTo s1
S4: Text3.Text = ""
Text3.Text = A(1) & A(2) & A(3) & A(4)
'S2
'S2: q = 0
' For j = 1 To 4
' Text3.Text = Text3.Text & A(j)
' Next
'S3
' For k = 4 To 2 Step -1
' D(k) = D(k) + E(k)
' p = D(k)
' If p = k Then
' E(k) = -1
' Else
' If p = 0 Then
' E(k) = 1
' q = q + 1
' Else
' p = p + q
' r = A(p)
' A(p) = A(p + 1)
' A(p + 1) = r
' GoTo S2
' End If
' End If
'Next
End Sub
Private Sub Form_Load()
StatusBar1.SimpleText = ""
StatusBar1.SimpleText = "本程序仅限四位（1，2，3，4）组成的排列生成！"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -