Sub Main() frmHRDMAIN.Show '显示主窗口 End Sub <B>CHRDNext封装计算下一步算法的类</b> Dim bs(1 To 12) As Long '棋子的开始状态,接收输入值 Dim ES(1 To 12) As Long '棋子的计算结束状态,生成输出值,中间变量 Dim hnum As Long '横放的将军的数量,输入值 Public iEndNum As Long '计算结束的下一步的数量,输出值 Dim SaveEnd(1 To 240) As Long '最后生成的存放结果数组,输出值 Public Function getid(id As Long) As Long getid = SaveEnd(id) End Function Public Sub GetNext(BEGINSTATE() As Long, BEGINHNUM As Long) Dim i As Long Dim MoveType As Long '移动方向 Dim iend As Long '记录移动结果 For i = 1 To 12 bs(i) = BEGINSTATE(i) '初始状态 Next i hnum = BEGINHNUM '横放的将军数量 iEndNum = 0 '初始化结果数量为0 If MoveCaoCao() = 0 Then AddEnd For i = 2 To hnum + 1 '移动横放的将军 For MoveType = 1 To 4 If MoveHtiger(MoveType, i) = 0 Then AddEnd Next MoveType Next i For i = hnum + 2 To 6 '移动竖放的将军 For MoveType = 1 To 4 If MoveVtiger(MoveType, i) = 0 Then AddEnd Next MoveType Next i For i = 7 To 10 '移动小卒 For MoveType = 1 To 4 If MoveFighter(MoveType, i) = 0 Then AddEnd Next MoveType Next i End Sub Private Sub AddEnd() '将End数组中的数据添加到SaveEnd中去,最后将iendnum的值加1 Dim i As Long For i = 1 To 12 SaveEnd(iEndNum * 12 + i) = ES(i) Next i iEndNum = iEndNum + 1 End Sub Private Sub SortEnd(BeginId As Long, EndId As Long) '将输出结果进行排序,保证小者在前,大者在后 Dim i As Long Dim j As Long Dim Swap As Long i = BeginId Do While i <= EndId - 1 j = i + 1 Do While j <= EndId If ES(i) > ES(j) Then Swap = ES(i): ES(i) = ES(j): ES(j) = Swap End If j = j + 1 Loop i = i + 1 Loop End Sub Private Function MoveFighter(move_type As Long, id As Long) As Long '初始化下一步的数据 Dim i As Long For i = 1 To 12 ES(i) = bs(i) Next i MoveFighter = -1 '初始化返回值 Select Case move_type Case 1 'up If ES(11) = ES(id) - 4 Then ES(id) = ES(id) - 4: ES(11) = ES(11) + 4 MoveFighter = 0: GoTo Sort End If If ES(12) = ES(id) - 4 Then ES(id) = ES(id) - 4: ES(12) = ES(12) + 4 MoveFighter = 0: GoTo Sort End If Case 2 'down If ES(11) = ES(id) + 4 Then ES(id) = ES(id) + 4: ES(11) = ES(11) - 4 MoveFighter = 0: GoTo Sort End If If ES(12) = ES(id) + 4 Then ES(id) = ES(id) + 4: ES(12) = ES(12) - 4 MoveFighter = 0: GoTo Sort End If Case 3 'left If ES(11) = ES(id) - 1 And ES(11) Mod 4 <> 0 Then ES(id) = ES(id) - 1: ES(11) = ES(11) + 1 MoveFighter = 0: GoTo Sort End If If ES(12) = ES(id) - 1 And ES(12) Mod 4 <> 0 Then ES(id) = ES(id) - 1: ES(12) = ES(12) + 1 MoveFighter = 0: GoTo Sort End If Case 4 'right If ES(11) = ES(id) + 1 And ES(11) Mod 4 <> 1 Then ES(id) = ES(id) + 1: ES(11) = ES(11) - 1 MoveFighter = 0: GoTo Sort End If If ES(12) = ES(id) + 1 And ES(12) Mod 4 <> 1 Then ES(id) = ES(id) + 1: ES(12) = ES(12) - 1 MoveFighter = 0: GoTo Sort End If End Select Sort: If MoveFighter = 0 Then SortEnd 7, 10 '对小卒排序 SortEnd 11, 12 '对空格排序 End If End Function Private Function MoveCaoCao() As Long 'step1初始化下一步的数据 Dim i As Long For i = 1 To 12 ES(i) = bs(i) Next i MoveCaoCao = -1 '初始化返回值,-1代表不成功 'up按照规则,限制曹操不能向上移动 'If ES(11) = ES(1) - 8 And ES(12) = ES(11) + 1 Then ' ES(1) = ES(1) - 4: ES(11) = ES(11) + 8: ES(12) = ES(12) + 8 ' MoveCaoCao = 0 'end if 'down If ES(11) = ES(1) + 8 And ES(12) = ES(11) + 1 Then ES(1) = ES(1) + 4: ES(11) = ES(11) - 8: ES(12) = ES(12) - 8 MoveCaoCao = 0: GoTo Sort End If 'left If ES(11) = ES(1) - 1 And ES(12) = ES(11) + 4 And (ES(11) Mod 4) <> 0 Then ES(1) = ES(1) - 1: ES(11) = ES(11) + 2: ES(12) = ES(12) + 2 MoveCaoCao = 0: GoTo Sort End If 'right If ES(11) = ES(1) + 2 And ES(12) = ES(11) + 4 And (ES(11) Mod 4) <> 1 Then ES(1) = ES(1) + 1: ES(11) = ES(11) - 2: ES(12) = ES(12) - 2 MoveCaoCao = 0: GoTo Sort End If '移动曹操以后,不需要重新进行排序 Sort: 'Do nothing End Function Private Function MoveHtiger(MoveType As Long, id As Long) As Long '初始化下一步的数据 Dim i As Long For i = 1 To 12 ES(i) = bs(i) Next i MoveHtiger = -1 '设置初始值 Select Case MoveType Case 1 'up If ES(11) = ES(id) - 4 And ES(12) = ES(11) + 1 Then ES(id) = ES(id) - 4: ES(11) = ES(11) + 4: ES(12) = ES(12) + 4 MoveHtiger = 0: GoTo Sort End If Case 2 'down If ES(11) = ES(id) + 4 And ES(12) = ES(11) + 1 Then ES(id) = ES(id) + 4: ES(11) = ES(11) - 4: ES(12) = ES(12) - 4 MoveHtiger = 0: GoTo Sort End If Case 3 'left If ES(11) = ES(id) - 1 And ES(11) Mod 4 <> 0 Then ES(id) = ES(id) - 1: ES(11) = ES(11) + 2 MoveHtiger = 0: GoTo Sort End If If ES(12) = ES(id) - 1 And ES(12) Mod 4 <> 0 Then ES(id) = ES(id) - 1: ES(12) = ES(12) + 2 MoveHtiger = 0: GoTo Sort End If Case 4 'right If ES(11) = ES(id) + 2 And ES(11) Mod 4 <> 1 Then ES(id) = ES(id) + 1: ES(11) = ES(11) - 2 MoveHtiger = 0: GoTo Sort End If If ES(12) = ES(id) + 2 And ES(12) Mod 4 <> 1 Then ES(id) = ES(id) + 1: ES(12) = ES(12) - 2 MoveHtiger = 0: GoTo Sort End If End Select Sort: If MoveHtiger = 0 Then SortEnd 2, hnum + 1 '横放将领排序 SortEnd 11, 12 '空格排序 End If End Function Private Function MoveVtiger(MoveType As Long, id As Long) As Long '初始化下一步的数据 Dim i As Long For i = 1 To 12 ES(i) = bs(i) Next i MoveVtiger = -1 Select Case MoveType Case 1 'up If ES(11) = ES(id) - 4 Then ES(id) = ES(id) - 4: ES(11) = ES(11) + 8: MoveVtiger = 0: GoTo Sort End If If ES(12) = ES(id) - 4 Then ES(id) = ES(id) - 4: ES(12) = ES(12) + 8: MoveVtiger = 0: GoTo Sort End If Case 2 'down If ES(11) = ES(id) + 8 Then ES(id) = ES(id) + 4: ES(11) = ES(11) - 8: MoveVtiger = 0: GoTo Sort End If If ES(12) = ES(id) + 8 Then ES(id) = ES(id) + 4: ES(12) = ES(12) - 8: MoveVtiger = 0: GoTo Sort End If Case 3 'left If ES(11) = ES(id) - 1 And ES(12) = ES(11) + 4 And ES(11) Mod 4 <> 0 Then ES(id) = ES(id) - 1: ES(11) = ES(11) + 1: ES(12) = ES(12) + 1 MoveVtiger = 0: GoTo Sort End If Case 4 'right If ES(11) = ES(id) + 1 And ES(12) = ES(11) + 4 And ES(11) Mod 4 <> 1 Then ES(id) = ES(id) + 1: ES(11) = ES(11) - 1: ES(12) = ES(12) - 1 MoveVtiger = 0: GoTo Sort End If End Select Sort: If MoveVtiger = 0 Then SortEnd hnum + 2, 6 '竖放将领排序 SortEnd 11, 12 '空格排序 End If End Function |